/* xsiview - XLISP interface to IVIEW dynamic graphics package.        */
/* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
/* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
/* You may give out copies of this software; for conditions see the    */
/* file COPYING included with this distribution.                       */

#include <string.h>
#include "xlisp.h"
#include "osdef.h"
#ifdef ANSI
#include "xlproto.h"
#include "xlsproto.h"
#include "iviewproto.h"
#include "Stproto.h"
#else
#include "xlfun.h"
#include "xlsfun.h"
#include "iviewfun.h"
#include "Stfun.h"
#endif ANSI
#include "xlsvar.h"

/* forward declarations */
#ifdef ANSI
LVAL clear_data(int);
int check_locations(LVAL,int);
void set_locations(IVIEW_WINDOW,LVAL,int,LVAL,int,int,int),
     check_strings(int,LVAL);
#else
LVAL clear_data();
int check_locations();
void set_locations(),
     check_strings();
#endif ANSI

/**************************************************************************/
/**                                                                      **/
/**                    General IView Data Functions                      **/
/**                                                                      **/
/**************************************************************************/

static int check_locations(data, vars)
	LVAL data;
	int vars;
{
  LVAL seq, x;
  int i, j, n;
  
  if (fixp(data)) {
    if (getfixnum(data) <= 0) xlerror("too few points", data);
    else return(getfixnum(data));
  }
  
  if (! consp(data)/* || llength(data) != vars */)
    xlerror("bad variable list", data);
  
  if (! sequencep(car(data))) xlerror("not a sequence", car(data));
  n = seqlen(car(data));
  
  for (i = 0; i < vars && consp(data); i++, data = cdr(data)) {
    if (! sequencep(car(data))) xlerror("not a sequence", car(data));
    if (seqlen(car(data)) != n) xlfail("sequences of different lengths");
    for (j = 0, seq = car(data); j < n; j++) {
      x = getnextelement(&seq, j);
      if (! numberp(x)) xlerror("not a number", x);
    }
  }
  return(n);
}

static void set_locations(w, object, type, data, vars, oldn, n)
    IVIEW_WINDOW w;
	LVAL object, data;
    int type;
	int  vars, oldn, n;
{
  LVAL seq, arg;
  int i, j;
  double x;

  if (fixp(data)) return;
  if (! xlgetkeyarg(sk_scale, &arg)) arg = s_true;
  
  for (i = 0; i < vars && consp(data); i++, data = cdr(data)) {
    for (j = oldn, seq = car(data); j < n; j++) {
      x = makedouble(getnextelement(&seq, j - oldn));
      switch (type) {
      case 'P': IViewSetPointValue(w, i, j, x); break;
      case 'L': IViewSetLineValue(w, i, j, x); break;
#ifdef USESTRINGS
      case 'S': IViewSetStringValue(w, i, j, x); break;
#endif /* USESTRINGS */
      }
    }
  }
}

static void check_strings(n, strings)
	int n;
	LVAL strings;
{
  int i;
  LVAL element;
  
  if (! sequencep(strings)) xlerror("not a sequence", strings);
  if (n != seqlen(strings)) xlerror("wrong sequence length", strings);
  for (i = 0; i < n; i++) {
    element = getnextelement(&strings, i);
    if (! stringp(element)) xlerror("not a string", element);
  }
}

static LVAL clear_data(which)
	int which;
{
  IVIEW_WINDOW w;
  LVAL object;
  
  object = xlgaobject();
  w = get_iview_address(object);
  
  switch(which) {
  case 'P': IViewClearPoints(w);  break;
  case 'L': IViewClearLines(w);   break;
#ifdef USESTRINGS
  case 'S': IViewClearStrings(w); break;
#endif /* USESTRINGS */
  }
  check_redraw(object, TRUE, TRUE);
  return(NIL);
}

/**************************************************************************/
/**                                                                      **/
/**                      IView Point Data Functions                      **/
/**                                                                      **/
/**************************************************************************/

void internal_iview_add_points(w, object, data)
	IVIEW_WINDOW w;
	LVAL object, data; 
{
  LVAL labels, arg;
  int i, n, oldn, vars, sym, hsym;
  char *str;
  StGWWinInfo /* char */ *gwinfo = IViewWindowWinInfo(w); /* changed JKL */

  if (! xlgetkeyarg(sk_point_labels, &labels)) labels = NIL;
  
  vars = IViewNumVariables(w);
  oldn = IViewNumPoints(w);
  n = check_locations(data, vars);
  
  IViewAddPoints(w, n);
  n = IViewNumPoints(w);
  set_locations(w, object, 'P', data, vars, oldn, n);
  
  if (labels != NIL) {
    check_strings(n - oldn, labels);
    for (i = oldn; i < n; i++) {
      str = (char *) getstring(getnextelement(&labels, i - oldn));
      IViewSetPointLabel(w, i, str);
    }
  }
  if (xlgetkeyarg(sk_color, &arg)) {
    StGWSetUseColor(gwinfo, TRUE);
    for (i = oldn; i < n; i++)
      IViewSetPointColor(w, i, decode_lisp_color(arg));
  }
  if (xlgetkeyarg(sk_symbol, &arg)) {
    decode_point_symbol(arg, &sym, &hsym);
    for (i = oldn; i < n; i++)
      IViewSetPointSymbol(w, i, sym, hsym);
  }
}

LVAL iview_add_points()
{
  IVIEW_WINDOW w;
  LVAL object, data;
  int old_n, n;
  
  object = xlgaobject();
  w = get_iview_address(object);
  data = xlgetarg();
  
  old_n = IViewNumPoints(w);
  internal_iview_add_points(w, object, data);
  n = IViewNumPoints(w);
  check_add_to_screen(object, 'P', old_n, n, FALSE);
  return(NIL);
}

LVAL iview_clear_points() { return(clear_data('P')); }

/**************************************************************************/
/**                                                                      **/
/**                      IView Line Data Functions                       **/
/**                                                                      **/
/**************************************************************************/

void internal_iview_add_lines(w, object, data)
    IVIEW_WINDOW w;
    LVAL object, data;
{
  int i, n, oldn, vars, width;
  StGWWinInfo /* char */ *gwinfo = IViewWindowWinInfo(w); /* changed JKL */
  LVAL arg;
  
  vars = IViewNumVariables(w);
  oldn = IViewNumLines(w);
  n = check_locations(data, vars);
  
  IViewAddLines(w, n);
  n = IViewNumLines(w);
  set_locations(w, object, 'L', data, vars, oldn, n);

  if (xlgetkeyarg(sk_type, &arg) && arg != s_solid)
    for (i = oldn; i < n; i++) IViewSetLineType(w, i, 1);
  if (xlgetkeyarg(sk_color, &arg)) {
    StGWSetUseColor(gwinfo, TRUE);
    for (i = oldn; i < n; i++)
      IViewSetLineColor(w, i, decode_lisp_color(arg));
  }
  if (xlgetkeyarg(sk_width, &arg) && fixp(arg)) {
    width = getfixnum(arg);
    for (i = oldn; i < n; i++)
      IViewSetLineWidth(w, i, width);
  }
}

LVAL iview_add_lines()
{
  IVIEW_WINDOW w;
  LVAL object, data;
  int n, oldn;
  
  object = xlgaobject();
  w = get_iview_address(object);
  data = xlgetarg();

  oldn = IViewNumLines(w);
  internal_iview_add_lines(w, object, data);
  n = IViewNumLines(w);
  check_add_to_screen(object, 'L', oldn, n, FALSE);
  return(NIL);
}
  
LVAL iview_clear_lines() { return(clear_data('L')); }

#ifdef USESTRINGS
/**************************************************************************/
/**                                                                      **/
/**                     IView String Data Functions                      **/
/**                                                                      **/
/**************************************************************************/

void internal_iview_add_strings(w, object, data)
	IVIEW_WINDOW w;
	LVAL object, data;
{
  LVAL strings;
  int i, n, oldn, vars;
  char *str;
  
  strings = xlgetarg();
  
  vars = IViewNumVariables(w);
  oldn = IViewNumStrings(w);
  n = check_locations(data, vars);
  check_strings(n, strings);
  
  IViewAddStrings(w, n);
  n = IViewNumStrings(w);
  set_locations(w, object, 'S', data, vars, oldn, n);
  
  for (i = oldn; i < n; i++) {
    str = (char *) getstring(getnextelement(&strings, i - oldn));
    IViewSetStringString(w, i, str);
  }
}

LVAL iview_add_strings()
{
  IVIEW_WINDOW w;
  LVAL object, data;
  int n, oldn;
  
  object = xlgaobject();
  w = get_iview_address(object);
  data = xlgetarg();

  oldn = IViewNumStrings(w);
  internal_iview_add_strings(w, object, data);
  n = IViewNumStrings(w);
  check_add_to_screen(object, 'S', oldn, n, FALSE);
  return(NIL);
}

LVAL iview_clear_strings() { return(clear_data('S')); }
#endif /* USESTRINGS */

/**************************************************************************/
/**                                                                      **/
/**                     Standard Callback Functions                      **/
/**                                                                      **/
/**************************************************************************/

LVAL iview_std_resize()
{
  IVIEW_WINDOW w;

  w = get_iview_address(xlgaobject());
  IViewStdResize(w);
  return(NIL);
}

LVAL iview_std_redraw()
{
  IVIEW_WINDOW w;

  w = get_iview_address(xlgaobject());
  IViewStdRedraw(w);
  return(NIL);
}

LVAL iview_std_redraw_background()
{
  IVIEW_WINDOW w;

  w = get_iview_address(xlgaobject());
  IViewStdRedrawBackground(w);
  return(NIL);
}

LVAL iview_std_redraw_content()
{
  IVIEW_WINDOW w;

  w = get_iview_address(xlgaobject());
  IViewStdRedrawContent(w);
  return(NIL);
}

void IViewRedrawBackground(w)
	IVIEW_WINDOW w;
{
  send_message((LVAL) IViewWindowGetObject(w), sk_redraw_background);
}

void IViewRedrawContent(w)
	IVIEW_WINDOW w;
{
  send_message((LVAL) IViewWindowGetObject(w), sk_redraw_content);
}

void IViewRedrawOverlays(w)
	IVIEW_WINDOW w;
{
  send_message((LVAL) IViewWindowGetObject(w), sk_redraw_overlays);
}

void IViewResizeOverlays(w)
	IVIEW_WINDOW w;
{
  send_message((LVAL) IViewWindowGetObject(w), sk_resize_overlays);
}

/**************************************************************************/
/**                                                                      **/
/**                        Miscellaneous Functions                       **/
/**                                                                      **/
/**************************************************************************/

void check_add_to_screen(object, which, old_n, n, redraw)
	LVAL object;
	int old_n, n, redraw;
{
  IVIEW_WINDOW w;
  StGWWinInfo /* char */ *gwinfo; /* changed JKL */
  int x, y;
  LVAL adjust;
  
  w = get_iview_address(object);
  gwinfo = StGWObWinInfo(object);
  if (! xlgetkeyarg(sk_draw, &adjust)) adjust = s_true;
  
  if (adjust != NIL) {
    if (redraw || old_n == 0) send_message(object, sk_redraw_content);
    else {
      StGrGetContentVariables(gwinfo, &x, &y);
      switch(which) {
      case 'P': IViewDrawDataPoints(w, x, y, old_n, n);   break;
      case 'L': IViewDrawDataLines(w, x, y, old_n, n);    break;
#ifdef USESTRINGS
      case 'S': IViewDrawDataStrings(w, x, y, old_n, n);  break;
#endif /* USESTRINGS */
      }
    }
  }
}

void check_redraw(object, deflt, content_only)
	LVAL object;
	int deflt, content_only;
{
  LVAL arg, msg;
  int redraw;
  
  if (xlgetkeyarg(sk_draw, &arg)) redraw = (arg != NIL);
  else redraw = deflt;
  
  msg = (content_only) ? sk_redraw_content : sk_redraw;
  if (redraw) send_message(object, msg);
}

int draw_key_arg(deflt)
	int deflt;
{
  int value = deflt, n, i;
  
  for (n = xlargc - 1, i = 0; i < n; i++) {
    if (sk_draw == xlargv[i]) {
	  value = (xlargv[i+1] != NIL) ? TRUE : FALSE;
	}
  }
  return(value);
}