void PackageError::initialize(Value initargs)
{
Value format_control = NULL_VALUE;
Value format_arguments = NULL_VALUE;
Value package = NULL_VALUE;
Value first, second;
while (consp(initargs))
{
first = xcar(initargs);
initargs = xcdr(initargs);
second = car(initargs);
initargs = cdr(initargs);
if (first == K_format_control)
{
if (format_control == NULL_VALUE)
format_control = second;
}
else if (first == K_format_arguments)
{
if (format_arguments == NULL_VALUE)
format_arguments = second;
}
else if (first == K_package)
{
if (package == NULL_VALUE)
package = second;
}
}
if (format_control != NULL_VALUE)
set_slot_value(S_format_control, format_control);
if (format_arguments != NULL_VALUE)
set_slot_value(S_format_arguments, format_arguments);
set_slot_value(S_package, package != NULL_VALUE ? package : NIL);
}
/* delete item from the list */
static VOID delete_menu_item P2C(LVAL, menu, LVAL, item)
{
LVAL item_list;
StMObDeleteItem(menu, item);
item_list = slot_value(menu, s_items);
item_list = remove_from_list(item, item_list);
set_slot_value(menu, s_items,item_list);
set_slot_value(item, s_menu, NIL);
}
VOID initialize_graph_window P1C(LVAL, object)
{
LVAL internals, value;
int v, width, height, size;
StGWWinInfo *gwinfo;
ColorCode bc,dc; /* added JKL */
internals = newadata(StGWWinInfoSize(), 1, FALSE);
set_slot_value(object, s_internals, consa(internals));
StGWInitWinInfo(object);
gwinfo = StGWObWinInfo(object);
if (gwinfo == NULL) return;
StGWSetObject(gwinfo, object);
if (slot_value(object, s_black_on_white) == NIL) {
bc = StGWBackColor(gwinfo); /* this seems better for color */
dc = StGWDrawColor(gwinfo); /* machines - 0 and 1 are not */
StGWSetDrawColor(gwinfo, bc); /* the default draw and back */
StGWSetBackColor(gwinfo, dc); /* colors on the Amiga JKL */
}
StGetScreenSize(&width, &height);
size = (width > height) ? width : height;
if ((value = slot_value(object, s_has_h_scroll)) != NIL) {
v = (fixp(value)) ? getfixnum(value) : size;
StGWSetHasHscroll(gwinfo, TRUE, v);
}
if ((value = slot_value(object, s_has_v_scroll)) != NIL) {
v = (fixp(value)) ? getfixnum(value) : size;
StGWSetHasVscroll(gwinfo, TRUE, v);
}
}
FileError(AbstractString * s, Value pathname)
: Condition(WIDETAG_CONDITION, get_layout_for_class())
{
set_format_control(make_value(s));
set_format_arguments(NIL);
set_slot_value(S_pathname, pathname);
}
/* :ISNEW Method */
LVAL xsmenu_isnew(V)
{
LVAL menu, title;
menu = xlgaobject();
title = xlgastring();
xllastarg();
if (strlen(getstring(title)) == 0) xlerror("title is too short", title);
object_isnew(menu);
set_slot_value(menu, s_title, title);
set_slot_value(menu, s_enabled, s_true);
return(menu);
}
PackageError::PackageError(const char * s, Value package)
: Condition(WIDETAG_CONDITION, get_layout_for_class())
{
set_format_control(make_simple_string(s));
set_format_arguments(NIL);
set_slot_value(S_package, package);
}
/* 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);
}
LOCAL VOID set_hardware_address P3C(CPTR, ptr, LVAL, object, int *, type)
{
LVAL t, p, last, result, oblistsym, newoblist;
if (! objectp(object)) xlerror("not an object", object);
oblistsym = s_hardware_objects;
if (! consp(getvalue(oblistsym))) setvalue(oblistsym, NIL);
xlstkcheck(4);
xlsave(t);
xlsave(p);
xlsave(result);
xlsave(newoblist);
t = cvfixnum((FIXTYPE) time_stamp);
p = cvfixnum((FIXTYPE) ptr);
result = last = consa(object);
result = cons(p, result);
result = cons(t, result);
newoblist = cons(result, getvalue(oblistsym));
setvalue(oblistsym, newoblist);
set_slot_value(object, s_hardware_address, result);
for (;*type != NONE; type++, last = cdr(last)) {
t = cvfixnum((FIXTYPE) *type);
t = consa(t);
rplacd(last, t);
}
xlpopn(4);
}
VOID newhistinternals P1C(LVAL, object)
{
LVAL val;
xlsave1(val);
val = newadata(sizeof(struct hist), 1, FALSE);
val = consa(val);
set_slot_value(object, s_histogram_internals, val);
xlpop();
}
static LVAL window_dimensions P2C(int, which, int, frame)
{
LVAL object, slot;
IVIEW_WINDOW w;
int a, b, set = FALSE;
object = xlgaobject();
if (moreargs()) {
set = TRUE;
a = getfixnum(xlgafixnum());
b = getfixnum(xlgafixnum());
}
xllastarg();
w = (IVIEW_WINDOW) GETWINDOWADDRESS(object);
slot = (which == 'L') ? s_location : s_size;
if (set) {
if (! frame) set_slot_value(object, slot, integer_list_2(a, b));
if (! IVIEW_WINDOW_NULL(w)) {
switch (which) {
case 'L': StWSetLocation(w, a, b, frame); break;
case 'S': StWSetSize(w, a, b, frame); break;
}
}
}
if (! IVIEW_WINDOW_NULL(w)) {
switch (which) {
case 'L':
StWGetLocation(w, &a, &b, FALSE);
set_slot_value(object, slot, integer_list_2(a, b));
if (frame) StWGetLocation(w, &a, &b, TRUE);
break;
case 'S':
StWGetSize(w, &a, &b, FALSE);
set_slot_value(object, slot, integer_list_2(a, b));
if (frame) StWGetSize(w, &a, &b, TRUE);
break;
}
return(integer_list_2(a, b));
}
else return(slot_value(object, slot));
}
void StMObAllocateMach(LVAL menu)
{
HMENU theMenu;
int menuID;
menuID = unique_id();
theMenu = CreatePopupMenu();
if (! theMenu) xlfail("menu allocation failed");
set_menu_address(theMenu, menu);
set_slot_value(menu, s_id, cvfixnum((FIXTYPE) menuID));
}
LVAL iview_window_menu(V)
{
LVAL object, menu = NULL;
int set = FALSE;
object = xlgaobject();
if (moreargs()) {
set = TRUE;
menu = xlgetarg();
}
xllastarg();
if (set) {
if (menu_p(menu)) set_slot_value(object, s_menu, menu);
else if (menu == NIL) set_slot_value(object, s_menu, NIL);
else xlerror("not a menu", menu);
}
return(slot_value(object, s_menu));
}
void ArithmeticError::initialize(Value initargs)
{
Value format_control = NULL_VALUE;
Value format_arguments = NULL_VALUE;
Value operation = NULL_VALUE;
Value operands = NULL_VALUE;
Value first, second;
while (consp(initargs))
{
first = xcar(initargs);
initargs = xcdr(initargs);
second = car(initargs);
initargs = cdr(initargs);
if (first == K_format_control)
{
if (format_control == NULL_VALUE)
format_control = second;
}
else if (first == K_format_arguments)
{
if (format_arguments == NULL_VALUE)
format_arguments = second;
}
else if (first == K_operation)
{
if (operation == NULL_VALUE)
operation = second;
}
else if (first == K_operands)
{
if (operands == NULL_VALUE)
operands = second;
}
}
if (format_control != NULL_VALUE)
set_slot_value(S_format_control, format_control);
if (format_arguments != NULL_VALUE)
set_slot_value(S_format_arguments, format_arguments);
set_slot_value(S_operation, operation != NULL_VALUE ? operation : NIL);
set_slot_value(S_operands, operands != NULL_VALUE ? operands : NIL);
}
/* append list of items to the menu */
static VOID append_items P2C(LVAL, menu, LVAL, new_items)
{
LVAL next, item, item_list;
/* Check all items are menu items and not installed */
for (next = new_items; consp(next); next = cdr(next)) {
item = car(next);
if (! menu_item_p(item)) xlerror("not a menu item", item);
if (item_installed_p(item)) xlerror("item already installed", item);
}
/* add items to the item list and set items menus to menu */
for (next = new_items; consp(next); next = cdr(next)) {
item = car(next);
item_list = rplac_end(slot_value(menu, s_items), item);
set_slot_value(menu, s_items,item_list);
set_slot_value(item, s_menu, menu);
}
if (StMObAllocated(menu)) StMObAppendItems(menu, new_items);
}
LOCAL VOID set_rotation_type P2C(LVAL, object, int, type)
{
LVAL value;
switch (type) {
case Pitching: value = s_pitching; break;
case Rolling: value = s_rolling; break;
case Yawing: value = s_yawing; break;
default: value = s_pitching; break;
}
set_slot_value(object, s_rotation_type, value);
}
/* enable or disable a menu */
void StMObEnable(LVAL menu, int enable)
{
int m;
HMENU addr;
if (StMObAllocated(menu) && StMObInstalled(menu)) {
addr = get_menu_address(menu);
m = get_menu_position(addr);
EnableMenuItem(hMainMenu,
m,
(enable ? MF_ENABLED : MF_GRAYED) | MF_BYPOSITION);
DrawMenuBar(hWndFrame);
}
set_slot_value(menu, s_enabled, (enable) ? s_true : NIL);
}
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));
}
VOID standard_hardware_clobber P1C(LVAL, object)
{
LVAL addr, oblist;
if (! objectp(object)) xlerror("not an object", object);
addr = slot_value(object, s_hardware_address);
oblist = getvalue(s_hardware_objects);
if (! listp(oblist)) xlerror("not a list", oblist);
setvalue(s_hardware_objects, xlcallsubr2(xdelete, addr, oblist));
set_slot_value(object, s_hardware_address, NIL);
send_callback_message(object, sk_clobber);
}
LVAL xswindow_title(V)
{
IVIEW_WINDOW w;
LVAL object, title;
char *str;
object = xlgaobject();
w = (IVIEW_WINDOW) GETWINDOWADDRESS(object);
if (moreargs()) {
title = xlgastring();
set_slot_value(object, s_title, title);
if (! IVIEW_WINDOW_NULL(w)) {
str = (char *) getstring(title);
StWSetTitle(w, str);
}
}
return(slot_value(object, s_title));
}
/* set an item instance variable; item and value supplied or on the stack */
static LVAL set_item_ivar P3C(int, which, LVAL, item, LVAL, value)
{
value = check_item_ivar(which, value);
switch (which) {
case 'T': set_slot_value(item, s_title, value); break;
case 'K': set_slot_value(item, s_key, value); break;
case 'M': set_slot_value(item, s_mark, value); break;
case 'S': set_slot_value(item, s_style, value); break;
case 'A': set_slot_value(item, s_action, value); break;
case 'E': set_slot_value(item, s_enabled, value); break;
default: xlfail("unknown item instance variable");
}
StMObSetItemProp(item, which);
return(value);
}
VOID StGWGetAllocInfo P7C(LVAL, object, char **, title,
int *, left, int *, top, int *, width, int *, height, int *, goAway)
{
LVAL window_title;
if (slot_value(object, s_hardware_address) != NIL)
send_message(object, sk_dispose);
window_title = slot_value(object, s_title);
if (!stringp(window_title)) {
window_title = cvstring(IVIEW_WINDOW_TITLE);
set_slot_value(object, s_title, window_title);
}
*title = (char *) getstring(window_title);
*left = IVIEW_WINDOW_LEFT;
*top = IVIEW_WINDOW_TOP;
*width = IVIEW_WINDOW_WIDTH;
*height = IVIEW_WINDOW_HEIGHT;
get_window_bounds(object, left, top, width, height);
*goAway = slot_value(object, s_go_away) != NIL;
}
ArithmeticError::ArithmeticError(Value operation, Value operands)
: Condition(WIDETAG_CONDITION, get_layout_for_class())
{
set_slot_value(S_operation, operation);
set_slot_value(S_operands, operands);
}
LOCAL VOID set_angle P2C(LVAL, object, double, alpha)
{
set_slot_value(object, s_rotation_angle, cvflonum((FLOTYPE) alpha));
}
LOCAL VOID set_showing_axes P2C(LVAL, object, int, showing)
{
set_slot_value(object, s_showing_axes, (showing) ? s_true : NIL);
}
ReaderError(Stream * stream, AbstractString * s) : StreamError(stream)
{
set_slot_value(S_format_control, make_value(new_simple_string(s)));
set_slot_value(S_format_arguments, NIL);
}
void Condition::set_format_control(Value format_control)
{
// iset(0, format_control);
// SYS_set_std_instance_slot_value(make_value(this), S_format_control, format_control);
set_slot_value(S_format_control, format_control);
}
void Condition::set_format_arguments(Value format_arguments)
{
// iset(1, format_arguments);
// SYS_set_std_instance_slot_value(make_value(this), S_format_arguments, format_arguments);
set_slot_value(S_format_arguments, format_arguments);
}
LOCAL VOID set_content_variables P4C(LVAL, object, unsigned, x, unsigned, y, unsigned, z)
{
StGWWinInfo *gwinfo = StGWObWinInfo(object);
StGrSetContentVariables(gwinfo, x, y);
set_slot_value(object, s_content_variables, integer_list_3(x, y, z));
}
ReaderError(Value streamarg, const char * s) : StreamError(streamarg)
{
set_slot_value(S_format_control, make_value(new_simple_string(s)));
set_slot_value(S_format_arguments, NIL);
}
LOCAL VOID set_cuing P2C(LVAL, object, int, cuing)
{
set_slot_value(object, s_depth_cuing, (cuing) ? s_true : NIL);
if (cuing) adjust_cuing(object);
else cuing_off(object);
}
