/* clisnew - initialize a new class */
LVAL clisnew(void)
{
LVAL self,ivars,cvars,super;
int n;
/* get self, the ivars, cvars and superclass */
self = xlgaobject();
ivars = xlgalist();
cvars = (moreargs() ? xlgalist() : NIL);
super = (moreargs() ? xlgaobject() : object);
xllastarg();
/* store the instance and class variable lists and the superclass */
setivar(self,IVARS,ivars);
setivar(self,CVARS,cvars);
setivar(self,CVALS,(cvars ? newvector(listlength(cvars)) : NIL));
setivar(self,SUPERCLASS,super);
/* compute the instance variable count */
n = listlength(ivars);
setivar(self,IVARCNT,cvfixnum((FIXTYPE)n));
n += getivcnt(super,IVARTOTAL);
setivar(self,IVARTOTAL,cvfixnum((FIXTYPE)n));
/* return the new class object */
return (self);
}
/* :DELETE-ITEMS Method */
LVAL xsdelete_items(V)
{
LVAL menu;
menu = xlgaobject();
while (moreargs())
delete_menu_item(menu, xlgaobject());
return(NIL);
}
/* obisa - does an object inherit from class? */
LVAL obisa(void)
{
LVAL self, cl, obcl;
self = xlgaobject();
cl = xlgaobject();
xllastarg();
obcl = getclass(self);
while (obcl) {
if (obcl == cl) return s_true;
obcl = getivar(obcl, SUPERCLASS);
}
return NIL;
}
/* handle simple imperative messages with no arguments */
static LVAL simple_menu_message P1C(int, which)
{
LVAL menu;
LVAL arg = NIL;
int set = FALSE;
menu = xlgaobject();
if (which == 'E') {
if (moreargs()) {
set = TRUE;
arg = (xlgetarg() != NIL) ? s_true : NIL;
}
}
xllastarg();
switch (which) {
case 'A': StMObAllocate(menu); break;
case 'D': StMObDispose(menu); break;
case 'E': if (set) {
set_slot_value(menu, s_enabled, arg);
StMObEnable(menu, (arg != NIL));
}
return(slot_value(menu, s_enabled));
case 'I': StMObInstall(menu); break;
case 'R': StMObRemove(menu); break;
case 'U': update_menu(menu); break;
default: xlfail("unknown message");
}
return(NIL);
}
/* get and check a menu from the argument list */
LVAL xsgetmenu(V)
{
LVAL menu;
menu = xlgaobject();
if (! menu_p(menu)) xlerror("not a menu", menu);
return(menu);
}
LVAL iview_spin_allocate(V)
{
LVAL object;
int vars, i, show, ascent, height;
IVIEW_WINDOW w;
StGWWinInfo *gwinfo;
object = xlgaobject();
show = xsboolkey(sk_show, TRUE);
gwinfo = StGWObWinInfo(object);
get_iview_ivars(object, &vars);
if (vars < 3) xlfail("too few variables");
w = IViewNew(object);
initialize_iview(w, object);
for (i = 0; i < vars; i++)
IViewSetScaledRange(w, i, -sqrt((double) vars), sqrt((double) vars));
set_content_variables(object, 0, 1, 2);
IViewSetIdentityTransformation(w);
set_rotation_type(object, Rolling);
set_angle(object, ALPHA);
ascent = StGWTextAscent(gwinfo);
height = (ascent > SPIN_CONTROL_SIZE) ? 2 * ascent : SPIN_CONTROL_HEIGHT;
StGrSetMargin(gwinfo, 0, 0, 0, height);
/* use StShowWindow to show (map) window but NOT send :resize or :redraw */
if (show) StShowWindow(w);
return(object);
}
/* obisnew - default 'isnew' method */
LVAL obisnew(void)
{
LVAL self;
self = xlgaobject();
xllastarg();
return (self);
}
LVAL iview_spin_resize(V)
{
IVIEW_WINDOW w;
LVAL object;
int vars, i, top, left, width, height, size;
StGWWinInfo *gwinfo;
object = xlgaobject();
xllastarg();
gwinfo = StGWObWinInfo(object);
w = (IVIEW_WINDOW) GETIVIEWADDRESS(object);
if (IVIEW_WINDOW_NULL(w) || gwinfo == NULL) return(NIL);
vars = IViewNumVariables(w);
IViewSetFixedAspect(w, TRUE);
IViewStdResize(w);
StGrGetContentRect(gwinfo, &left, &top, &width, &height);
size = width;
StGrSetContentOrigin(gwinfo, left + size / 2, top + size / 2);
for (i = 0; i < vars; i++)
IViewSetScreenRange(w, i, - size / 2, size / 2);
StGWGetViewRect(gwinfo, &left, &top, &width, &height);
StGWSetClipRect(gwinfo, TRUE, left, top, width, height);
return(NIL);
}
LVAL iview_spin_draw_axes(V)
{
IVIEW_WINDOW w;
int x, y, xorig, yorig, size, xend, yend, vars, i, unit;
char *s;
double **a;
StGWWinInfo *gwinfo;
LVAL object;
object = xlgaobject();
w = (IVIEW_WINDOW) GETIVIEWADDRESS(object);
gwinfo = StGWObWinInfo(object);
if (! IVIEW_WINDOW_NULL(w)) {
StGrGetContentVariables(gwinfo, &x, &y);
StGrGetContentOrigin(gwinfo, &xorig, &yorig);
StGrGetContentRect(gwinfo, NULL, NULL, &size, NULL);
vars = IViewNumVariables(w);
a = IViewTransformation(w);
unit = size / 2;
for (i = 0; i < vars; i++) {
xend = xorig + a[x][i] * AXIS_FRACTION * unit;
yend = yorig - a[y][i] * AXIS_FRACTION * unit;
StGWDrawLine(gwinfo, xorig, yorig, xend, yend);
s = IViewVariableLabel(w, i);
xend += LABEL_OFFSET;
yend -= LABEL_OFFSET;
StGWDrawString(gwinfo, s, xend, yend);
}
}
return(NIL);
}
/* obclass - get the class of an object */
LVAL obclass(void)
{
LVAL self;
self = xlgaobject();
xllastarg();
return (getclass(self));
}
LVAL iview_transformation(V)
{
IVIEW_WINDOW w;
LVAL m = NULL, object;
int set = FALSE;
int vars;
object = xlgaobject();
w = (IVIEW_WINDOW) get_iview_address(object);
if (moreargs()) {
set = TRUE;
m = xlgetarg();
}
vars = IViewNumVariables(w);
if (set) {
if (m == NIL) IViewSetIdentityTransformation(w);
else {
set_internal_transformation(vars, m, NIL);
IViewSetTransformation(w, transform);
}
check_redraw(object, TRUE, TRUE);
}
else m = (IViewIsTransformed(w))
? make_transformation(IViewTransformation(w), vars) : NIL;
return(m);
}
LVAL xshidewindow(V)
{
LVAL object = xlgaobject();
IVIEW_WINDOW w = (IVIEW_WINDOW) GETWINDOWADDRESS(object);
if (! IVIEW_WINDOW_NULL(w)) StHideWindow(w);
return(NIL);
}
LVAL iview_std_adjust_screen(V)
{
IVIEW_WINDOW w;
w = (IVIEW_WINDOW) get_iview_address(xlgaobject());
IViewStdAdjustScreen(w);
return(NIL);
}
static LVAL item_ivar P1C(int, which)
{
LVAL item;
item = xlgaobject();
if (moreargs()) set_item_ivar(which, item, xlgetarg());
return(get_item_ivar(which, item));
}
/* get and check a menu item from the argument stack */
LVAL xsgetmenuitem(V)
{
LVAL item;
item = xlgaobject();
if (! menu_item_p(item)) xlerror("not a menu item", item);
return(item);
}
LVAL iview_spin_angle(V)
{
LVAL object;
object = xlgaobject();
if (moreargs()) set_angle(object, makefloat(xlgetarg()));
xllastarg();
return(slot_value(object, s_rotation_angle));
}
/* :ISNEW message for IVIEW-WINDOW-CLASS */
LVAL iview_window_isnew(V)
{
LVAL object = xlgaobject();
int show = xsboolkey(sk_show, TRUE);
object_isnew(object);
initialize_graph_window(object);
if (show) send_message(object, sk_allocate);
return(object);
}
LVAL iview_spin_rotate(V)
{
IVIEW_WINDOW w;
w = (IVIEW_WINDOW) GETIVIEWADDRESS(xlgaobject());
xllastarg();
if (! IVIEW_WINDOW_NULL(w)) IViewSpinRotate(w);
return(NIL);
}
LVAL iview_spin_depth_cuing(V)
{
LVAL object;
object = xlgaobject();
if (moreargs())
set_cuing(object, (xlgetarg() != NIL) ? TRUE : FALSE);
xllastarg();
return((is_cuing(object)) ? s_true : NIL);
}
/* :APPEND-ITEMS Method */
LVAL xsappend_items(V)
{
LVAL menu, new_items;
xlsave1(new_items);
menu = xlgaobject();
new_items = makearglist(xlargc, xlargv);
append_items(menu, new_items);
xlpop();
return(NIL);
}
LVAL iview_spin_showing_axes(V)
{
LVAL object;
object = xlgaobject();
if (moreargs())
set_showing_axes(object, (xlgetarg() != NIL) ? TRUE : FALSE);
xllastarg();
return((is_showing_axes(object)) ? s_true : NIL);
}
LVAL iview_std_adjust_screen_point(V)
{
LVAL object;
int point;
object = xlgaobject();
point = getfixnum(xlgafixnum());
xllastarg();
IViewStdAdjustScreenPoint((IVIEW_WINDOW) get_iview_address(object), point);
return(NIL);
}
LVAL iview_scaled_range()
{
LVAL object = xlgaobject(), result;
int set = (xlargc > 1) ? TRUE : FALSE, draw;
wind = get_iview_address(object);
draw = draw_key_arg(TRUE);
range_type = 'S';
result = range();
if (set) check_redraw(object, draw, FALSE);
return(result);
}
LVAL xsshowwindow(V)
{
LVAL object = xlgaobject();
IVIEW_WINDOW w = (IVIEW_WINDOW) GETWINDOWADDRESS(object);
if (IVIEW_WINDOW_NULL(w)) {
send_message(object, sk_allocate);
w = (IVIEW_WINDOW) GETWINDOWADDRESS(object);
}
if (! IVIEW_WINDOW_NULL(w)) StShowWindow(w);
return(NIL);
}
LVAL iview_spin_redraw_content(V)
{
IVIEW_WINDOW w;
LVAL object;
object = xlgaobject();
w = (IVIEW_WINDOW) GETIVIEWADDRESS(object);
xllastarg();
if (! IVIEW_WINDOW_NULL(w)) redraw_content(w, object);
return(NIL);
}
/* :ALLOCATE message for IVIEW-WINDOW-CLASS */
LVAL iview_window_allocate(V)
{
LVAL object;
IVIEW_WINDOW w;
object = xlgaobject();
w = IViewWindowNew(object, TRUE);
/* use StShowWindow to show (map) window but NOT send :resize or :redraw */
if (xsboolkey(sk_show, TRUE)) StShowWindow(w);
return(object);
}
LVAL xsiview_window_update(V)
{
#ifdef MACINTOSH
LVAL object;
int resized;
object = xlgaobject();
resized = (xlgetarg() != NIL);
xllastarg();
graph_update_action(StGWObWinInfo(object), resized);
#endif /* MACINTOSH */
return(NIL);
}
/* :ISNEW Method */
LVAL xsitem_isnew(V)
{
LVAL item, title, value;
item = xlgaobject();
title = xlgastring();
set_item_ivar('T', item, title);
object_isnew(item);
if (xlgetkeyarg(sk_enabled, &value)) set_item_ivar('E', item, value);
else set_item_ivar('E', item, s_true);
return(NIL); /* to keep compilers happy - L. Tierney */
}
LVAL xsmenu_title(V)
{
LVAL menu, title;
menu = xlgaobject();
if (moreargs()) {
title = xlgastring();
if (strlen(getstring(title)) == 0)
xlerror("title is too short", title);
if (StMObAllocated(menu))
xlfail("can't change title of an allocated menu");
set_slot_value(menu, s_title, title);
}
return(slot_value(menu, s_title));
}
LVAL iview_std_mark_points_in_rect(V)
{
IVIEW_WINDOW w;
int left, top, width, height;
w = (IVIEW_WINDOW) get_iview_address(xlgaobject());
left = getfixnum(xlgafixnum());
top = getfixnum(xlgafixnum());
width = getfixnum(xlgafixnum());
height = getfixnum(xlgafixnum());
xllastarg();
IViewStdMarkPointsInRect(w, left, top, width, height);
return(NIL);
}
