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 / xsiview2.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-10-03  |  15.4 KB  |  514 lines
  1. /* xsiview2 - 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. #else
  15. #include "xlfun.h"
  16. #include "xlsfun.h"
  17. #include "iviewfun.h"
  18. #endif ANSI
  19. #include "xlsvar.h"
  20.  
  21. /* forward declarations */
  22. #ifdef ANSI
  23. LVAL number_of(int),base_coordinate(void),coordinate(void),
  24.      basic_data_coordinate(int,int),base_mask(void),mask(void),
  25.      basic_data_mask(int),base_color(void),color(void),
  26.      basic_data_color(int),base_point_info(void),point_info(void),
  27.      internal_point_info(int),base_line_info(void),line_info(void),
  28.      internal_line_info(int),base_string_modifiers(void),
  29.      string_modifiers(void),internal_string_modifiers(void);
  30. #else
  31. LVAL number_of(),base_coordinate(),coordinate(),
  32.      basic_data_coordinate(),base_mask(),mask(),
  33.      basic_data_mask(,base_color(),color(),
  34.      basic_data_color(,base_point_info(),point_info(),
  35.      internal_point_info(),base_line_info(),line_info(),
  36.      internal_line_info(),base_string_modifiers(),
  37.      string_modifiers(),internal_string_modifiers();
  38. #endif ANSI
  39.  
  40. /* static global variables */
  41. static IVIEW_WINDOW wind;
  42. static int data_type, coordinate_type, info_type;
  43.  
  44. /**************************************************************************/
  45. /**                                                                      **/
  46. /**                    General IView Data Functions                      **/
  47. /**                                                                      **/
  48. /**************************************************************************/
  49.  
  50. static LVAL number_of(what)
  51.     int what;
  52. {
  53.   IVIEW_WINDOW w;
  54.   int val;
  55.   
  56.   w = get_iview_address(xlgaobject());
  57.   xllastarg();
  58.   
  59.   switch(what) {
  60.   case 'V': val = IViewNumVariables(w); break;
  61.   case 'P': val = IViewNumPoints(w);    break;
  62.   case 'L': val = IViewNumLines(w);     break;
  63. #ifdef USESTRINGS
  64.   case 'S': val = IViewNumStrings(w);   break;
  65. #endif /* USESTRINGS */
  66.   }
  67.   
  68.   return(cvfixnum((FIXTYPE) val));
  69. }
  70.  
  71. LVAL iview_num_variables() { return(number_of('V')); }
  72.  
  73. static LVAL base_coordinate()
  74. {
  75.   int var, point, set = FALSE;
  76.   double value;
  77.   LVAL result;
  78.   
  79.   var = getfixnum(xlgafixnum());
  80.   point = getfixnum(xlgafixnum());
  81.   if (moreargs()) {
  82.     set = TRUE;
  83.     switch (coordinate_type) {
  84.     case 'V': value = makedouble(xlgetarg()); break;
  85.     case 'S': xlfail("can't set screen coordinate directly");
  86.     case 'T': xlfail("can't set transformed coordinate directly");
  87.     default:  xlfail("unknown coordinate type");
  88.     }
  89.   }
  90.   
  91.   if (set)
  92.     switch (data_type) {
  93.     case 'P': IViewSetPointValue(wind, var, point, value);  break;
  94.     case 'L': IViewSetLineValue(wind, var, point, value);   break;
  95. #ifdef USESTRINGS
  96.     case 'S': IViewSetStringValue(wind, var, point, value); break;
  97. #endif /* USESTRINGS */
  98.     }
  99.   
  100.   switch (data_type) {
  101.   case 'P': 
  102.     if (coordinate_type == 'V')
  103.       result = cvflonum((FLOTYPE) IViewPointValue(wind, var, point));
  104.     else if (coordinate_type == 'S')
  105.       result = cvfixnum((FIXTYPE) IViewPointScreenValue(wind, var, point));
  106.     else
  107.       result = cvflonum((FLOTYPE) IViewPointTransformedValue(wind, var, point));
  108.     break;
  109.   case 'L':
  110.     if (coordinate_type == 'V')
  111.       result = cvflonum((FLOTYPE) IViewLineValue(wind, var, point));
  112.     else if (coordinate_type == 'S')
  113.       result = cvfixnum((FIXTYPE) IViewLineScreenValue(wind, var, point));
  114.     else
  115.       result = cvflonum((FLOTYPE) IViewLineTransformedValue(wind, var, point));
  116.     break;
  117. #ifdef USESTRINGS
  118.   case 'S':
  119.     if (coordinate_type == 'V')
  120.       result = cvflonum((FLOTYPE) IViewStringValue(wind, var, point));
  121.     else if (coordinate_type == 'S')
  122.       result = cvfixnum((FIXTYPE) IViewStringScreenValue(wind, var, point));
  123.     else
  124.       result = cvflonum((FLOTYPE) IViewStringTransformedValue(wind, var, point));
  125.     break;
  126. #endif /* USESTRINGS */
  127.   }
  128.   return(result);
  129. }
  130.  
  131. static LVAL coordinate()
  132. {
  133.   return(recursive_subr_map_elements(base_coordinate, coordinate));
  134. }
  135.  
  136. static LVAL basic_data_coordinate(type, action)
  137.      int type, action;
  138. {
  139.   wind = get_iview_address(xlgaobject());
  140.   data_type = type;
  141.   coordinate_type = action;
  142.   return(coordinate());
  143. }
  144.  
  145. static LVAL base_mask()
  146. {
  147.   int point, masked, set = FALSE;
  148.   
  149.   point = getfixnum(xlgafixnum());
  150.   if (moreargs()) {
  151.     set = TRUE;
  152.     masked = (xlgetarg() != NIL) ? TRUE : FALSE;
  153.   }
  154.   
  155.   if (set)
  156.     switch (data_type) {
  157.     case 'P': IViewSetPointMask(wind, point, masked);  break;
  158.     case 'L': IViewSetLineMask(wind, point, masked);   break;
  159. #ifdef USESTRINGS
  160.     case 'S': IViewSetStringMask(wind, point, masked); break;
  161. #endif /* USESTRINGS */
  162.     }
  163.   
  164.   switch (data_type) {
  165.     case 'P': masked = IViewPointMasked(wind, point);  break;
  166.     case 'L': masked = IViewLineMasked(wind, point);   break;
  167. #ifdef USESTRINGS
  168.     case 'S': masked = IViewStringMasked(wind, point); break;
  169. #endif /* USESTRINGS */
  170.   }
  171.   return((masked) ? s_true : NIL);
  172. }
  173.  
  174. static LVAL mask()
  175. {
  176.   return(recursive_subr_map_elements(base_mask, mask));
  177. }
  178.  
  179. static LVAL basic_data_mask(type)
  180.     int type;
  181. {
  182.   wind = get_iview_address(xlgaobject());
  183.   data_type = type;
  184.   return(mask());
  185. }
  186.  
  187. static LVAL base_color()
  188. {
  189.   int point, /* color, */ set = FALSE; /* changed JKL */
  190.   ColorCode color;
  191.   LVAL arg;
  192.   
  193.   point = getfixnum(xlgafixnum());
  194.   if (moreargs()) {
  195.     set = TRUE;
  196.     arg = xlgetarg();
  197.     color = (arg != NIL) ? decode_lisp_color(arg) : -1;
  198.   }
  199.   
  200.   if (set)
  201.     switch (data_type) {
  202.     case 'P': IViewSetPointColor(wind, point, color);  break;
  203.     case 'L': IViewSetLineColor(wind, point, color);   break;
  204. #ifdef USESTRINGS
  205.     case 'S': IViewSetStringColor(wind, point, color); break;
  206. #endif /* USESTRINGS */
  207.     }
  208.   
  209.   switch (data_type) {
  210.     case 'P': color = IViewPointColor(wind, point);  break;
  211.     case 'L': color = IViewLineColor(wind, point);   break;
  212. #ifdef USESTRINGS
  213.     case 'S': color = IViewStringColor(wind, point); break;
  214. #endif /* USESTRINGS */
  215.   }
  216.   return((color >= 0) ? encode_lisp_color(color) : NIL);
  217. }
  218.  
  219. static LVAL color()
  220. {
  221.   return(recursive_subr_map_elements(base_color, color));
  222. }
  223.  
  224. static LVAL basic_data_color(type)
  225.     int type;
  226. {
  227.   wind = get_iview_address(xlgaobject());
  228.   data_type = type;
  229.   return(color());
  230. }
  231.  
  232. /**************************************************************************/
  233. /**                                                                      **/
  234. /**                      IView Point Data Functions                      **/
  235. /**                                                                      **/
  236. /**************************************************************************/
  237.  
  238. LVAL iview_num_points() { return(number_of('P')); }
  239.  
  240. LVAL iview_point_coordinate()        { return(basic_data_coordinate('P', 'V')); }
  241. LVAL iview_point_screen_coordinate() { return(basic_data_coordinate('P', 'S')); }
  242. LVAL iview_point_transformed_coordinate() { return(basic_data_coordinate('P', 'T')); }
  243.  
  244. LVAL iview_point_masked() { return(basic_data_mask('P')); }
  245. LVAL iview_point_color() { return(basic_data_color('P')); }
  246.  
  247. static LVAL base_point_info()
  248. {
  249.   int point, marked, sym, hsym, set = FALSE;
  250.   char *label;
  251.   PointState state;
  252.   LVAL arg, result;
  253.   
  254.   /* get the arguments */
  255.   point = getfixnum(xlgafixnum());
  256.   if (moreargs()) {
  257.     set = TRUE;
  258.     switch(info_type) {
  259.     case 'S':
  260.     case 's':
  261.       arg = xlgasymbol();
  262.       if (arg == s_invisible) state = pointInvisible;
  263.       else if (arg == s_normal) state = pointNormal;
  264.       else if (arg == s_hilited) state = pointHilited;
  265.       else if (arg == s_selected) state = pointSelected;
  266.       else xlerror("unknown point state", arg);
  267.       break;
  268.     case 'M': marked = (xlgetarg() != NIL) ? TRUE : FALSE; break;
  269.     case 'L': label = (char *) getstring(xlgastring());  break;
  270.     case 'X':
  271.       arg = xlgetarg();
  272.       if (symbolp(arg)) decode_point_symbol(arg, &sym, &hsym);
  273.       else {
  274.         if (! fixp(arg)) xlbadtype(arg);
  275.         sym = getfixnum(arg);
  276.         hsym = getfixnum(xlgafixnum());
  277.       }
  278.       break;
  279.     }
  280.   }
  281.   
  282.   /* set the new state if value was supplied */
  283.   if (set)
  284.     switch (info_type) {
  285.     case 'S': IViewSetPointState(wind, point, state);       break;
  286.     case 's': IViewSetPointScreenState(wind, point, state); break;
  287.     case 'M': IViewSetPointMark(wind, point, marked);       break;
  288.     case 'L': IViewSetPointLabel(wind, point, label);       break;
  289.     case 'X': IViewSetPointSymbol(wind, point, sym, hsym);  break;
  290.     }
  291.   
  292.   /* get the current state */
  293.   switch (info_type) {
  294.   case 'S': state = IViewPointState(wind, point);           break;
  295.   case 's': state = IViewPointScreenState(wind, point);     break;
  296.   case 'M': marked = IViewPointMarked(wind, point);         break;
  297.   case 'L': label = IViewPointLabel(wind, point);           break;
  298.   case 'X': IViewGetPointSymbol(wind, point, &sym, &hsym);  break;
  299.   }
  300.   
  301.   /* code the current state as a lisp object */
  302.   switch (info_type) {
  303.   case 'S':
  304.   case 's':
  305.     switch (state) {
  306.     case pointInvisible: result = s_invisible; break;
  307.     case pointNormal:    result = s_normal;    break;
  308.     case pointHilited:   result = s_hilited;   break;
  309.     case pointSelected:  result = s_selected;  break;
  310.     default: xlfail("unknown point state");
  311.     }
  312.     break;
  313.   case 'M': result = (marked) ? s_true : NIL; break;
  314.   case 'L': 
  315.     if (label == nil) result = newstring(1);
  316.     else {
  317.       result = newstring(strlen(label) + 1);
  318.       strcpy(getstring(result), label);
  319.     }
  320.     break;
  321.   case 'X': result = encode_point_symbol(sym, hsym); break;
  322.   }
  323.   
  324.   /* return the current state */
  325.   return(result);
  326. }
  327.  
  328. static LVAL point_info()
  329. {
  330.   return(recursive_subr_map_elements(base_point_info, point_info));
  331. }
  332.  
  333. static LVAL internal_point_info(type)
  334.     int type;
  335. {
  336.   wind = get_iview_address(xlgaobject());
  337.   if (type == 'S' && xlargc > 1) IViewCheckLinks(wind);
  338.   info_type = type;
  339.   return(point_info());
  340. }
  341.  
  342. LVAL iview_point_state()        { return(internal_point_info('S')); }
  343. LVAL iview_point_screen_state() { return(internal_point_info('s')); }
  344. LVAL iview_point_marked()       { return(internal_point_info('M')); }
  345. LVAL iview_point_label()        { return(internal_point_info('L')); }
  346. LVAL iview_point_symbol()       { return(internal_point_info('X')); }
  347.  
  348.  
  349. /**************************************************************************/
  350. /**                                                                      **/
  351. /**                      IView Line Data Functions                       **/
  352. /**                                                                      **/
  353. /**************************************************************************/
  354.  
  355. LVAL iview_num_lines() { return(number_of('L')); }
  356.  
  357. LVAL iview_line_coordinate()        { return(basic_data_coordinate('L', 'V')); }
  358. LVAL iview_line_screen_coordinate() { return(basic_data_coordinate('L', 'S')); }
  359. LVAL iview_line_transformed_coordinate() { return(basic_data_coordinate('L', 'T')); }
  360.  
  361. LVAL iview_line_masked() { return(basic_data_mask('L')); }
  362. LVAL iview_line_color() { return(basic_data_color('L')); }
  363.  
  364. static LVAL base_line_info()
  365. {
  366.   int line, next, type, width, set = FALSE;
  367.   LVAL arg, result;
  368.   
  369.   /* get the arguments */
  370.   line = getfixnum(xlgafixnum());
  371.   if (moreargs()) {
  372.     set = TRUE;
  373.     switch(info_type) {
  374.     case 'N': 
  375.       arg = xlgetarg();
  376.       next = (fixp(arg)) ? getfixnum(arg) : -1;
  377.       break;
  378.     case 'T':
  379.       arg = xlgasymbol();
  380.       if (arg == s_solid) type = 0;
  381.       else if (arg == s_dashed) type = 1;
  382.       else xlerror("unknown line type", arg);
  383.       break;
  384.     case 'P':
  385.       width = getfixnum(xlgafixnum());
  386.     }
  387.   }
  388.   
  389.   /* set the new state if value was supplied */
  390.   if (set)
  391.     switch (info_type) {
  392.     case 'N': IViewSetNextLine(wind, line, next);   break;
  393.     case 'T': IViewSetLineType(wind, line, type);   break;
  394.     case 'P': IViewSetLineWidth(wind, line, width); break;
  395.     }
  396.   
  397.   /* get the current state */
  398.   switch (info_type) {
  399.   case 'N': next = IViewNextLine(wind, line);                 break;
  400.   case 'T': type = IViewLineType(wind, line);                 break;
  401.   case 'P': IViewGetLineWidth(wind, line, &width); break;
  402.   }
  403.   
  404.   /* code the current state as a lisp object */
  405.   switch (info_type) {
  406.   case 'N': result = (next >= 0) ? cvfixnum((FIXTYPE) next) : NIL; break;
  407.   case 'T':
  408.     if (type == 0) result = s_solid;
  409.     else result = s_dashed;
  410.     break;
  411.   case 'P': result = cvfixnum((FIXTYPE) width); break;
  412.   }
  413.   
  414.   /* return the current state */
  415.   return(result);
  416. }
  417.  
  418. static LVAL line_info()
  419. {
  420.   return(recursive_subr_map_elements(base_line_info, line_info));
  421. }
  422.  
  423. static LVAL internal_line_info(type)
  424.     int type;
  425. {
  426.   wind = get_iview_address(xlgaobject());
  427.   info_type = type;
  428.   return(line_info());
  429. }
  430.  
  431. LVAL iview_line_next()  { return(internal_line_info('N')); }
  432. LVAL iview_line_type()  { return(internal_line_info('T')); }
  433. LVAL iview_line_width() { return(internal_line_info('P')); }
  434.  
  435. #ifdef USESTRINGS
  436. /**************************************************************************/
  437. /**                                                                      **/
  438. /**                     IView String Data Functions                      **/
  439. /**                                                                      **/
  440. /**************************************************************************/
  441.  
  442. LVAL iview_num_strings() { return(number_of('S')); }
  443.  
  444. LVAL iview_string_coordinate()        { return(basic_data_coordinate('S', 'V')); }
  445. LVAL iview_string_screen_coordinate() { return(basic_data_coordinate('S', 'S')); }
  446. LVAL iview_string_transformed_coordinate() { return(basic_data_coordinate('S', 'T')); }
  447.  
  448. LVAL iview_string_masked() { return(basic_data_mask('S')); }
  449. LVAL iview_string_color() { return(basic_data_color('S')); }
  450.  
  451. static LVAL base_string_modifiers()
  452. {
  453.   int string, up, h, v, set = FALSE;
  454.   LVAL arg, temp, result;
  455.   
  456.   /* get the arguments */
  457.   string = getfixnum(xlgafixnum());
  458.   if (moreargs()) {
  459.     set = TRUE;
  460.     up = (xlgetarg() != NIL) ? TRUE : FALSE;
  461.     arg = xlgasymbol();
  462.     if (arg == s_left) h = 0;
  463.     else if (arg == s_center) h = 1;
  464.     else if (arg == s_right) h = 2;
  465.     else xlerror("unknown string justification mode", arg);
  466.     arg = xlgasymbol();
  467.     if (arg == s_bottom) v = 0;
  468.     else if (arg == s_top) v = 1;
  469.     else xlerror("unknown string justification mode", arg);
  470.   }
  471.   
  472.   /* set the new state if value was supplied */
  473.   if (set) IViewSetStringModifiers(wind, string, up, h, v);
  474.     
  475.   /* get the current state */
  476.   IViewGetStringModifiers(wind, string, &up, &h, &v);
  477.   
  478.   /* code the current state as a lisp object */
  479.   xlsave1(result);
  480.   switch (v) {
  481.   case 0: temp = s_bottom; break;
  482.   case 1: temp = s_top; break;
  483.   default: xlfail("unknown string justification mode");
  484.   }
  485.   result = consa(temp);
  486.   switch(h) {
  487.   case 0: temp = s_left; break;
  488.   case 1: temp = s_center; break;
  489.   case 2: temp = s_right; break;
  490.   default: xlfail("unknown string justification mode");
  491.   }
  492.   result = cons(temp, result);
  493.   temp = (up) ? s_true : NIL;
  494.   result = cons(temp, result);
  495.   xlpop();
  496.   
  497.   /* return the current state */
  498.   return(result);
  499. }
  500.  
  501. static LVAL string_modifiers()
  502. {
  503.   return(recursive_subr_map_elements(base_string_modifiers, string_modifiers));
  504. }
  505.  
  506. static LVAL internal_string_modifiers()
  507. {
  508.   wind = get_iview_address(xlgaobject());
  509.   return(string_modifiers());
  510. }
  511.  
  512. LVAL iview_string_modifiers() { return(internal_string_modifiers()); }
  513. #endif /* USESTRINGS */
  514.