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 / xsiview3.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-10-08  |  13.3 KB  |  509 lines
  1. /* xsiview3 - 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 <string.h>
  8. #include "xlisp.h"
  9. #include "osdef.h"
  10. #ifdef ANSI
  11. #include "xlproto.h"
  12. #include "xlsproto.h"
  13. #include "iviewproto.h"
  14. #include "Stproto.h"
  15. #else
  16. #include "xlfun.h"
  17. #include "xlsfun.h"
  18. #include "iviewfun.h"
  19. #include "Stfun.h"
  20. #endif ANSI
  21. #include "xlsvar.h"
  22.  
  23. /* forward declarations */
  24. #ifdef ANSI
  25. LVAL base_variable_label(void),variable_label(void),base_range(void),
  26.   range(void),base_screen_range(void),screen_range(void),
  27.   newmatrix(unsigned,unsigned),make_transformation(double **,int),
  28.   draw_data(int);
  29. void set_internal_transformation(int,LVAL,LVAL);
  30. #else
  31. LVAL base_variable_label(),variable_label(),base_range(),
  32.   range(),base_screen_range(),screen_range(),
  33.   newmatrix(),make_transformation(),draw_data();
  34. void set_internal_transformation();
  35. #endif ANSI
  36.  
  37. /* static global variables */
  38. static int maxvars = 0;
  39. static double **transform, *transformdata;
  40. static int *inbasis;
  41. static IVIEW_WINDOW wind;
  42. static int range_type;
  43.  
  44. /**************************************************************************/
  45. /**                                                                      **/
  46. /**                    General IView Data Functions                      **/
  47. /**                                                                      **/
  48. /**************************************************************************/
  49.  
  50. static LVAL base_variable_label()
  51. {
  52.   int var, set = FALSE;
  53.   char *label;
  54.   LVAL result;
  55.   
  56.   var = getfixnum(xlgafixnum());
  57.   if (moreargs()) {
  58.     set = TRUE;
  59.     label = (char *) getstring(xlgastring());
  60.   }
  61.   xllastarg();
  62.   
  63.   if (set) IViewSetVariableLabel(wind, var, label);
  64.   
  65.   label = IViewVariableLabel(wind, var);
  66.   if (label == nil) result = newstring(1);
  67.   else {
  68.     result = newstring(strlen(label) + 1);
  69.     strcpy(getstring(result), label);
  70.   }
  71.   
  72.   return(result);
  73. }
  74.  
  75. static LVAL variable_label()
  76. {
  77.   return(recursive_subr_map_elements(base_variable_label, variable_label));
  78. } 
  79.  
  80. LVAL iview_variable_label()
  81. {
  82.   wind = get_iview_address(xlgaobject());
  83.   return(variable_label());
  84. }
  85.  
  86. static LVAL base_range()
  87. {
  88.   int var, set = FALSE;
  89.   double low, high;
  90.   
  91.   var = getfixnum(xlgafixnum());
  92.   if (moreargs()) {
  93.     set = TRUE;
  94.     low = makedouble(xlgetarg());
  95.     high = makedouble(xlgetarg());
  96.   }
  97.   
  98.   if (set) {
  99.     if (range_type != 'S') IViewSetRange(wind, var, low, high);
  100.     else IViewSetScaledRange(wind, var, low, high);
  101.   }
  102.   if (range_type != 'S') IViewGetRange(wind, var, &low, &high);
  103.   else IViewGetScaledRange(wind, var, &low, &high);
  104.  
  105.   return(double_list_2(low, high));
  106. }
  107.  
  108. static LVAL range()
  109. {
  110.   return(recursive_subr_map_elements(base_range, range));
  111. }
  112.  
  113. LVAL iview_range()
  114. {
  115.   LVAL object = xlgaobject(), result;            /* added JKL */
  116.   int set = (xlargc  > 1) ? TRUE : FALSE, draw, showing = NIL, a, b;
  117.  
  118.   wind = get_iview_address(object);
  119.   StGrGetContentVariables(IViewWindowWinInfo(wind),&a,&b);/* 3 lines added JKL */
  120.   if(getfixnum(xlargv[0])==a)IViewGetXaxis(wind, &showing, 0, 0);
  121.   else if(getfixnum(xlargv[0])==b)IViewGetYaxis(wind, &showing, 0, 0);
  122.   draw = draw_key_arg(TRUE) && showing;  /* && added JKL */
  123.   range_type = 'N';
  124.   result = range();
  125.   if (set) check_redraw(object, draw, FALSE);
  126.   return(result);
  127. }
  128.  
  129. LVAL iview_scaled_range()
  130. {
  131.   LVAL object = xlgaobject(), result;            /* added JKL */
  132.   int set = (xlargc  > 1) ? TRUE : FALSE, draw, showing = NIL, a, b;
  133.  
  134.   wind = get_iview_address(object);
  135.   StGrGetContentVariables(IViewWindowWinInfo(wind),&a,&b);/* 3 lines added JKL */
  136.   if(getfixnum(xlargv[0])==a)IViewGetXaxis(wind, &showing, 0, 0);
  137.   else if(getfixnum(xlargv[0])==b)IViewGetYaxis(wind, &showing, 0, 0);
  138.   draw = draw_key_arg(TRUE) && showing;  /* && added JKL */
  139.   range_type = 'S';
  140.   result = range();
  141.   if (set) check_redraw(object, draw, FALSE);
  142.   return(result);
  143. }
  144.  
  145. static LVAL base_screen_range()
  146. {
  147.   int var, set = FALSE;
  148.   int low, high;
  149.   
  150.   var = getfixnum(xlgafixnum());
  151.   if (moreargs()) {
  152.     set = TRUE;
  153.     low = getfixnum(xlgafixnum());
  154.     high = getfixnum(xlgafixnum());
  155.   }
  156.   xllastarg();
  157.   
  158.   if (set) IViewSetScreenRange(wind, var, low, high);
  159.   IViewGetScreenRange(wind, var, &low, &high);
  160.   
  161.   return(integer_list_2(low, high));
  162. }
  163.  
  164. static LVAL screen_range()
  165. {
  166.   return(recursive_subr_map_elements(base_screen_range, screen_range));
  167. }
  168.  
  169. LVAL iview_screen_range()
  170. {
  171.   wind = get_iview_address(xlgaobject());
  172.   return(screen_range());
  173. }
  174.  
  175. static void set_internal_transformation(vars, m, b)
  176.     int vars;
  177.     LVAL m, b;
  178. {
  179.   int i, j, k, rows, cols;
  180.   LVAL data;
  181.   
  182.   if (vars <= 0) return;
  183.   if (vars > maxvars) {
  184.     maxvars = 0;
  185.     StFree(transformdata);
  186.     StFree(transform);
  187.     StFree(inbasis);
  188.     transformdata = (double *) StCalloc(vars * vars, sizeof(double));
  189.     transform = (double **) StCalloc(vars, sizeof(double *));
  190.     for (i = 0; i < vars; i++) transform[i] = transformdata + vars * i;
  191.     inbasis = (int *) StCalloc(vars, sizeof(double));
  192.     maxvars = vars;
  193.   }
  194.   
  195.   if (! matrixp(m)) xlerror("not a matrix", m);
  196.   rows = numrows(m);
  197.   cols = numcols(m);
  198.   if (rows > vars) rows = vars;
  199.   if (cols > vars) cols = vars;
  200.   if (rows != cols) xlerror("bad transformation matrix", m);
  201.  
  202.   /* fill in upper left corner of transform from m; rest is identity */
  203.   data = arraydata(m);
  204.   for (i = 0, k = 0; i < rows; i++) {
  205.     for (j = 0; j < cols; j++, k++)
  206.       transform[i][j] = makedouble(getelement(data, k));
  207.     for (j = cols; j < vars; j++)
  208.       transform[i][j] = (i == j) ? 1.0 : 0.0;
  209.   }
  210.   for (i = rows; i < vars; i++)
  211.     for (j = 0; j < vars; j++)
  212.       transform[i][j] = (i == j) ? 1.0 : 0.0;
  213.     
  214.   /* figure out basis elements using b and size of m */
  215.   if (b != NIL) {
  216.     if (! sequencep(b)) xlerror("not a sequence", b);
  217.     if (seqlen(b) != rows) xlerror("wrong length for basis", b);
  218.     for (i = 0; i < rows; i++)
  219.       inbasis[i] = (getnextelement(&b, i) != NIL) ? TRUE : FALSE;
  220.   }
  221.   else for (i = 0; i < rows; i++) inbasis[i] = TRUE;
  222.   for (i = rows; i < vars; i++) inbasis[i] = FALSE;
  223. }
  224.  
  225. static LVAL newmatrix(r, c)
  226.     unsigned r, c;
  227. {
  228.   LVAL rows, cols, dim, result;
  229.   
  230.   
  231.   xlstkcheck(3);
  232.   xlsave(rows);
  233.   xlsave(cols);
  234.   xlsave(dim);
  235.   
  236.   rows = cvfixnum((FIXTYPE) r);
  237.   cols = cvfixnum((FIXTYPE) c);
  238.   dim = list2(rows, cols);
  239.   result = newarray(dim, NIL, NIL);
  240.   xlpopn(3);
  241.   
  242.   return(result);
  243. }
  244.  
  245. static LVAL make_transformation(a, vars)
  246.     double **a;
  247.     int vars;
  248. {
  249.   LVAL result, data;
  250.   int i, j, k;
  251.   
  252.   if (a == nil) return(NIL);
  253.   
  254.   xlsave1(result);
  255.   result = newmatrix(vars, vars);
  256.   data = arraydata(result);
  257.   for (i = 0, k = 0; i < vars; i++)
  258.     for (j = 0; j < vars; j++, k++)
  259.       setelement(data, k, cvflonum((FLOTYPE) a[i][j]));
  260.   xlpop();
  261.   return(result);
  262. }
  263.  
  264. LVAL iview_transformation()
  265. {
  266.   IVIEW_WINDOW w;
  267.   LVAL m, object;
  268.   int set = FALSE;
  269.   int vars;
  270.   
  271.   object = xlgaobject();
  272.   w = get_iview_address(object);
  273.   if (moreargs()) {
  274.     set = TRUE;
  275.     m = xlgetarg();
  276.   }
  277.   
  278.   vars = IViewNumVariables(w);
  279.   if (set) {
  280.     if (m == NIL) IViewSetIdentityTransformation(w);
  281.     else {
  282.       set_internal_transformation(vars, m, NIL);
  283.       IViewSetTransformation(w, transform);
  284.     }
  285.     check_redraw(object, TRUE, TRUE);
  286.   }
  287.   else m = (IViewIsTransformed(w))
  288.          ? make_transformation(IViewTransformation(w), vars) : NIL;
  289.   
  290.   return(m);
  291. }
  292.  
  293. LVAL iview_apply_transformation()
  294. {
  295.   IVIEW_WINDOW w;
  296.   LVAL m, b, object;
  297.   int vars;
  298.  
  299.   object = xlgaobject();
  300.   w = get_iview_address(object);
  301.   m = xsgetmatrix();
  302.   if (! xlgetkeyarg(sk_basis, &b)) b = NIL;
  303.  
  304.   vars = IViewNumVariables(w);
  305.   set_internal_transformation(vars, m, b);
  306.   IViewApplyTransformation(w, transform, inbasis);
  307.   check_redraw(object, TRUE, TRUE);
  308.   
  309.   return(NIL);
  310. }
  311.  
  312. /**************************************************************************/
  313. /**                                                                      **/
  314. /**                     IView Data Drawing Functions                     **/
  315. /**                                                                      **/
  316. /**************************************************************************/
  317.  
  318. static LVAL draw_data(which)
  319.     int which;
  320. {
  321.   IVIEW_WINDOW w;
  322.   int var1, var2, m, n;
  323.   
  324.   w = get_iview_address(xlgaobject());
  325.   var1 = getfixnum(xlgafixnum());
  326.   var2 = getfixnum(xlgafixnum());
  327.   m = getfixnum(xlgafixnum());
  328.   n = getfixnum(xlgafixnum());
  329.   xllastarg();
  330.   
  331.   switch(which) {
  332.   case 'P': IViewDrawDataPoints(w, var1, var2, m, n); break;
  333.   case 'L': IViewDrawDataLines(w, var1, var2, m, n); break;
  334. #ifdef USESTRINGS
  335.   case 'S': IViewDrawDataStrings(w, var1, var2, m, n); break;
  336. #endif /* USESTRINGS */
  337.   }
  338.   return(NIL);
  339. }
  340.  
  341. LVAL iview_draw_data_points()  { return(draw_data('P')); }
  342. LVAL iview_draw_data_lines()   { return(draw_data('L')); }
  343. #ifdef USESTRINGS
  344. LVAL iview_draw_data_strings() { return(draw_data('S')); }
  345. #endif /* USESTRINGS */
  346.  
  347. /**************************************************************************/
  348. /**                                                                      **/
  349. /**                     Standard Callback Functions                      **/
  350. /**                                                                      **/
  351. /**************************************************************************/
  352.  
  353. LVAL iview_std_mark_points_in_rect()
  354. {
  355.   IVIEW_WINDOW w;
  356.   int left, top, width, height;
  357.  
  358.   w = get_iview_address(xlgaobject());
  359.   left = getfixnum(xlgafixnum());
  360.   top = getfixnum(xlgafixnum());
  361.   width = getfixnum(xlgafixnum());
  362.   height = getfixnum(xlgafixnum());
  363.   xllastarg();
  364.   
  365.   IViewStdMarkPointsInRect(w, left, top, width, height);
  366.   return(NIL);
  367. }
  368.  
  369. LVAL iview_std_adjust_screen()
  370. {
  371.   IVIEW_WINDOW w;
  372.   
  373.   w = get_iview_address(xlgaobject());
  374.   IViewStdAdjustScreen(w);
  375.   return(NIL);
  376. }
  377.  
  378. PointState decode_point_state(state)
  379.     LVAL state;
  380. {
  381.   if (state == s_invisible) return(pointInvisible);
  382.   else if (state == s_normal) return(pointNormal);
  383.   else if (state == s_hilited) return(pointHilited);
  384.   else if (state == s_selected) return(pointSelected);
  385.   else xlerror("unknown point state", state);
  386. }
  387.   
  388. LVAL iview_std_adjust_points_in_rect()
  389. {
  390.   IVIEW_WINDOW w;
  391.   int left, top, width, height;
  392.   PointState state;
  393.   
  394.   w = get_iview_address(xlgaobject());
  395.   left = getfixnum(xlgafixnum());
  396.   top = getfixnum(xlgafixnum());
  397.   width = getfixnum(xlgafixnum());
  398.   height = getfixnum(xlgafixnum());
  399.   state = decode_point_state(xlgetarg());
  400.   xllastarg();
  401.   
  402.   IViewStdAdjustPointsInRect(w, left, top, width, height, state);
  403.   return(NIL);
  404. }
  405.  
  406. LVAL iview_std_adjust_screen_point()
  407. {
  408.   LVAL object;
  409.   int point;
  410.  
  411.   object = xlgaobject();
  412.   point = getfixnum(xlgafixnum());
  413.   xllastarg();
  414.  
  415.   IViewStdAdjustScreenPoint(get_iview_address(object), point);
  416.   return(NIL);
  417. }
  418.  
  419. /**************************************************************************/
  420. /**                                                                      **/
  421. /**                       IView Rotation Functions                       **/
  422. /**                                                                      **/
  423. /**************************************************************************/
  424.  
  425. LVAL iview_rotate_2()
  426. {
  427.   IVIEW_WINDOW w;
  428.   int var1, var2;
  429.   double alpha;
  430.   LVAL object;
  431.   
  432.   object = xlgaobject();
  433.   w = get_iview_address(object);
  434.   var1 = getfixnum(xlgafixnum());
  435.   var2 = getfixnum(xlgafixnum());
  436.   alpha = makedouble(xlgetarg());
  437.   
  438.   IViewRotate2(w, var1, var2, alpha);
  439.   check_redraw(object, TRUE, TRUE);
  440.   
  441.   return(NIL);
  442. }
  443.  
  444. /**************************************************************************/
  445. /**                                                                      **/
  446. /**                        Miscellaneous Functions                       **/
  447. /**                                                                      **/
  448. /**************************************************************************/
  449.  
  450. LVAL iview_get_nice_range()
  451. {
  452.   double low, high;
  453.   int ticks;
  454.   LVAL temp, result;
  455.   
  456.   low = makedouble(xlgetarg());
  457.   high = makedouble(xlgetarg());
  458.   ticks = getfixnum(xlgafixnum());
  459.   xllastarg();
  460.   
  461.   GetNiceRange(&low, &high, &ticks);
  462.   xlstkcheck(2);
  463.   xlsave(result);
  464.   xlsave(temp);
  465.   temp = cvfixnum((FIXTYPE) ticks); result = consa(temp);
  466.   temp = cvflonum((FLOTYPE) high); result = cons(temp, result);
  467.   temp = cvflonum((FLOTYPE) low); result = cons(temp, result);  
  468.   xlpopn(2);
  469.   
  470.   return(result);
  471. }
  472.  
  473. LVAL iview_adjust_depth_cuing()
  474. {
  475.   LVAL object;
  476.   int vz;
  477.   IVIEW_WINDOW w;
  478.   int i, low, high, cut1, cut2, cut3, z, nz;
  479.   int next, n;
  480.   
  481.   object = xlgaobject();
  482.   vz = getfixnum(xlgafixnum());
  483.   xllastarg();
  484.   
  485.   w = GETIVIEWADDRESS(object);
  486.   if (w == nil) return(NIL);
  487.  
  488.   IViewGetScreenRange(w, vz, &low, &high);
  489.   cut1 = (low + high) / 2 - (high - low) / 8;
  490.   cut2 = (low + high) / 2;
  491.   cut3 = (low + high) / 2 + (high - low) / 8;
  492.   n  = IViewNumPoints(w);
  493.   IViewDepthCuePoints(w, vz, cut1, cut2, cut3, 0, n);
  494.   cut1 = (low + high) / 2 - (high - low) / 8;
  495.   cut3 = (low + high) / 2 + (high - low) / 8;
  496.   n = IViewNumLines(w);
  497.   for (i = 0; i < n; i++) {
  498.     z = IViewLineScreenValue(w, vz, i);
  499.     next = IViewNextLine(w, i);
  500.     nz = (next >= 0)
  501.        ? IViewLineScreenValue(w, vz, next) : z;
  502.     z = (z + nz) / 2;
  503.     if (z < cut1) IViewSetLineWidth(w, i, 1);
  504.     else if (z < cut3) IViewSetLineWidth(w, i, 2);
  505.     else IViewSetLineWidth(w, i, 3);
  506.   }
  507.   return(NIL);
  508. }
  509.