src/c/xsiview3.c

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