home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Fred Fish Collection 1.5
/
ffcollection-1-5-1992-11.iso
/
ff_disks
/
300-399
/
ff386.lzh
/
XLispStat
/
src1.lzh
/
IView
/
dialogs.c
< prev
next >
Wrap
C/C++ Source or Header
|
1990-10-07
|
21KB
|
782 lines
/* dialogs - General Dialog Objects */
/* 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 "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 simple_dialog_method(int),make_text_item(LVAL),process_items(LVAL);
Point calc_item_size(LVAL,LVAL,int,int),
calc_item_list_size(LVAL,LVAL,int,int,int);
void calc_size(LVAL),calc_location(LVAL),get_initial_item_values(LVAL,int);
#else
LVAL simple_dialog_method(),make_text_item(),process_items();
Point calc_item_size(),
calc_item_list_size();
void calc_size(),calc_location(),get_initial_item_values();
#endif
/* layout definitions */
# define ITEM_GAP 10
# define SCROLL_MIN 0
# define SCROLL_MAX 100
# define SCROLL_PAGE 5
# define has_item_location(i) (slot_value(i, s_location) != NIL)
# define has_item_size(i) (slot_value(i, s_size) != NIL)
# define check_dialog_address(d) valid_dialog_address(slot_value(d, s_hardware_address))
/***********************************************************************/
/** **/
/** Utility Functions **/
/** **/
/***********************************************************************/
int check_point_list(x)
LVAL x;
{
return(listp(x) && llength(x) == 2 && fixp(car(x)) && fixp(car(cdr(x))));
}
Point ListToPoint(list)
LVAL list;
{
Point pt;
if (! check_point_list(list)) xlerror("not a point", list);
pt.h = getfixnum(car(list));
pt.v = getfixnum(car(cdr(list)));
return(pt);
}
LVAL PointToList(pt)
Point pt;
{
return(integer_list_2((int) pt.h, (int) pt.v));
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** DIALOG-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/***********************************************************************/
/** **/
/** Support Functions **/
/** **/
/***********************************************************************/
/* Is this a dialog? */
int dialog_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_dialog_proto)));
}
/* get a dialog from the stack */
LVAL xsgetdialog()
{
LVAL x;
x = xlgetarg();
if (! dialog_p(x)) xlerror("not a dialog", x);
return(x);
}
static Point calc_item_size(dialog, item, left, top)
LVAL dialog, item;
int left, top;
{
Point sz, loc;
if (! dialog_item_p(item)) xlerror("not a dialog item", item);
if (slot_value(item, s_dialog) != NIL
&& check_dialog_address(slot_value(item, s_dialog)))
xlfail("item is already installed in a dialog");
sz = ListToPoint(slot_value(item, s_size));
if (has_item_location(item))
loc = ListToPoint(slot_value(item, s_location));
else {
loc.h = left;
loc.v = top;
set_slot_value(item, s_location, PointToList(loc));
}
sz.h += loc.h - left;
sz.v += loc.v - top;
sz.h = max((int) sz.h, 0);
sz.v = max((int) sz.v, 0);
set_slot_value(item, s_dialog, dialog);
return(sz);
}
static Point calc_item_list_size(dialog, items, left, top, as_column)
LVAL dialog, items;
int left, top, as_column;
{
LVAL item;
Point sz, pt;
for (sz.h = 0, sz.v = 0; consp(items); items = cdr(items)) {
item = car(items);
if consp(item)
pt = calc_item_list_size(dialog, item, left, top, ! as_column);
else pt = calc_item_size(dialog, item, left, top);
if (as_column) {
sz.h = max((int) sz.h, (int) pt.h);
sz.v += pt.v + ITEM_GAP;
top += pt.v + ITEM_GAP;
}
else {
sz.h += pt.h + ITEM_GAP;
left += pt.h + ITEM_GAP;
sz.v = max((int) sz.v, (int) pt.v);
}
}
if (as_column) sz.v = max((int) (sz.v - ITEM_GAP), 0);
else sz.h = max((int) (sz.h - ITEM_GAP), 0);
return(sz);
}
static void calc_size(dialog)
LVAL dialog;
{
Point sz;
LVAL size = slot_value(dialog, s_size);
LVAL items = slot_value(dialog, s_items);
sz = calc_item_list_size(dialog, items, ITEM_GAP, ITEM_GAP, TRUE);
sz.h += 2 * ITEM_GAP;
sz.v += 2 * ITEM_GAP;
if (! check_point_list(size)) {
set_slot_value(dialog, s_size, PointToList(sz));
}
}
static void calc_location(dialog)
LVAL dialog;
{
Point screen, size, location;
int left, top;
LVAL loc = slot_value(dialog, s_location);
if (! check_point_list(loc)) {
StGetScreenSize(&left, &top);
screen.h = left; screen.v = top; /* needed since components may be shorts */
size = ListToPoint(slot_value(dialog, s_size));
location.h = (screen.h - size.h) / 2;
location.v = (screen.v - size.v) / 2;
set_slot_value(dialog, s_location, PointToList(location));
}
}
static LVAL simple_dialog_method(which)
int which;
{
LVAL dialog, result = NIL;
dialog = xsgetdialog();
xllastarg();
switch (which) {
case 'R': DialogRemove(dialog); break;
case 'A': calc_size(dialog);
calc_location(dialog);
DialogAllocate(dialog);
break;
case 'a': result = (check_dialog_address(dialog)) ? s_true : NIL; break;
}
return(result);
}
/*
extern LVAL s_text_item_proto, sk_new;
extern LVAL copylist(); in headers JKL */
static LVAL make_text_item(string)
LVAL string;
{
LVAL result;
result = send_message_1L(getvalue(s_text_item_proto), sk_new, string);
return(result);
}
static LVAL process_items(items)
LVAL items;
{
LVAL next;
xlprot1(items);
items = copylist(items);
for (next = items; consp(next); next = cdr(next)) {
if (stringp(car(next))) rplaca(next, make_text_item(car(next)));
else if (consp(car(next))) rplaca(next, process_items(car(next)));
}
xlpop();
return(items);
}
/***********************************************************************/
/** **/
/** Methods **/
/** **/
/***********************************************************************/
/* :ISNEW Method */
LVAL xsdialog_isnew()
{
LVAL dialog, items;
dialog = xsgetdialog();
items = xlgalist();
items = process_items(items);
set_slot_value(dialog, s_items, items);
object_isnew(dialog);
if (! stringp(slot_value(dialog, s_title)))
set_slot_value(dialog, s_title, make_string("Dialog"));
if (xsboolkey(sk_show, TRUE)) send_message(dialog, sk_allocate);
return(dialog);
}
LVAL xsdialog_allocate() { return(simple_dialog_method('A')); }
LVAL xsdialog_remove() { return(simple_dialog_method('R')); }
LVAL xsdialog_allocated_p() { return(simple_dialog_method('a')); }
LVAL xsdialog_default_button()
{
LVAL dialog, item;
dialog = xsgetdialog();
item = xlgetarg();
xllastarg();
DialogSetDefaultButton(dialog, item);
return (item);
}
/* :MODAL-DIALOG method */
LVAL xsdialog_modal()
{
LVAL dialog;
dialog = xsgetdialog();
xllastarg();
return(DialogGetModalItem(dialog));
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** DIALOG-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a dialog-item? */
int dialog_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_dialog_item_proto)));
}
/* get a dialog item from the stack */
LVAL xsgetdialogitem()
{
LVAL x;
x = xlgetarg();
if (! dialog_item_p(x)) xlerror("not a dialog item", x);
return(x);
}
static void get_initial_item_values(item, get_first)
LVAL item;
int get_first;
{
LVAL text;
if (get_first) {
text = xlgastring();
set_slot_value(item, s_text, text);
}
object_isnew(item);
}
/* :DO-ACTION Method */
LVAL xsdialog_item_do_action()
{
LVAL item, action/*, result rewritten below JKL */;
item = xsgetdialogitem();
xllastarg();
action = slot_value(item, s_action);
/* result = (action != NIL) ? xlapply(pushargs(action, NIL)) : NIL;*/
return(/*result*/(action != NIL) ? xlapply(pushargs(action, NIL)) : NIL);
}
/* :ACTION Method */
LVAL xsdialog_item_action()
{
LVAL item, action;
int set;
item = xsgetdialogitem();
set = moreargs();
if (set) action = xlgetarg();
xllastarg();
if (set) set_slot_value(item, s_action, action);
return(slot_value(item, s_action));
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** BUTTON-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a button-item? */
int button_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_button_item_proto)));
}
/* get a button item from the stack */
LVAL xsgetbuttonitem()
{
LVAL x;
x = xlgetarg();
if (! button_item_p(x)) xlerror("not a button item", x);
return(x);
}
/* :ISNEW Method */
LVAL xsbutton_item_isnew()
{
LVAL item;
int width, height;
item = xsgetbuttonitem();
get_initial_item_values(item, TRUE);
if (! has_item_size(item)) {
DialogButtonGetDefaultSize(item, &width, &height);
set_slot_value(item, s_size, integer_list_2(width, height));
}
return(item);
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** TOGGLE-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a toggle-item? */
int toggle_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_toggle_item_proto)));
}
/* get a toggle item from the stack */
LVAL xsgettoggleitem()
{
LVAL x;
x = xlgetarg();
if (! toggle_item_p(x)) xlerror("not a toggle item", x);
return(x);
}
/* :ISNEW Method */
LVAL xstoggle_item_isnew()
{
LVAL item;
int width, height;
item = xsgettoggleitem();
get_initial_item_values(item, TRUE);
if (! has_item_size(item)) {
DialogToggleGetDefaultSize(item, &width, &height);
set_slot_value(item, s_size, integer_list_2(width, height));
}
return(item);
}
/* :VALUE Method */
LVAL xstoggle_item_value()
{
LVAL item, value;
int set;
item = xsgettoggleitem();
set = moreargs();
if (set) value = xlgetarg();
xllastarg();
return(DialogToggleItemValue(item, set, value));
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** TEXT-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a text-item? */
int text_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_text_item_proto)));
}
/* get a text item from the stack */
LVAL xsgettextitem()
{
LVAL x;
x = xlgetarg();
if (! text_item_p(x)) xlerror("not a text item", x);
return(x);
}
/* :ISNEW Method */
LVAL xstext_item_isnew()
{
LVAL item, edit;
int width, height;
item = xsgettextitem();
get_initial_item_values(item, TRUE);
if (xlgetkeyarg(sk_editable, &edit) && edit != NIL)
set_slot_value(item, s_editable, s_true);
if (! has_item_size(item)) {
DialogTextGetDefaultSize(item, &width, &height);
set_slot_value(item, s_size, integer_list_2(width, height));
}
return(item);
}
/* :TEXT Method */
LVAL xstext_item_text()
{
LVAL item;
int set;
char *text;
item = xsgettextitem();
set = moreargs();
if (set) text = (char *) getstring(xlgastring());
xllastarg();
return(DialogTextItemText(item, set, text));
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** CHOICE-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a choice-item? */
int choice_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_choice_item_proto)));
}
/* get a choice item from the stack */
LVAL xsgetchoiceitem()
{
LVAL x;
x = xlgetarg();
if (! choice_item_p(x)) xlerror("not a choice item", x);
return(x);
}
/* :ISNEW Method */
LVAL xschoice_item_isnew()
{
LVAL item, text, next;
int width, height;
item = xsgetchoiceitem();
text = xlgalist();
for (next = text; consp(next); next = cdr(next))
if (! stringp(car(next))) xlerror("not a string", car(next));
set_slot_value(item, s_text, text);
get_initial_item_values(item, FALSE);
if (! has_item_size(item)) {
DialogChoiceGetDefaultSize(item, &width, &height);
set_slot_value(item, s_size, integer_list_2(width, height));
}
if (! fixp(slot_value(item, s_value)))
set_slot_value(item, s_value, cvfixnum((FIXTYPE) 0));
return(item);
}
/* :VALUE Method */
LVAL xschoice_item_value()
{
LVAL item;
int value, set;
item = xsgetchoiceitem();
set = moreargs();
if (set) value = getfixnum(xlgafixnum());
xllastarg();
return(DialogChoiceItemValue(item, set, value));
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** SCROLL-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a scroll-item? */
int scroll_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_scroll_item_proto)));
}
/* get a scroll item from the stack */
LVAL xsgetscrollitem()
{
LVAL x;
x = xlgetarg();
if (! scroll_item_p(x)) xlerror("not a scroll item", x);
return(x);
}
/* :ISNEW Method */
LVAL xsscroll_item_isnew()
{
LVAL item, low, high, page;
int width, height;
item = xsgetscrollitem();
get_initial_item_values(item, FALSE);
if (! xlgetkeyarg(sk_min_value, &low) || ! fixp(low))
low = cvfixnum((FIXTYPE) SCROLL_MIN);
set_slot_value(item, s_min_value, low);
if (! fixp(slot_value(item, s_value)))
set_slot_value(item, s_value, low);
if (! xlgetkeyarg(sk_max_value, &high) || ! fixp(high))
high = cvfixnum((FIXTYPE) SCROLL_MAX);
set_slot_value(item, s_max_value, high);
if (! xlgetkeyarg(sk_page_increment, &page) || ! fixp(page))
page = cvfixnum((FIXTYPE) SCROLL_PAGE);
set_slot_value(item, s_page_increment, page);
if (! has_item_size(item)) {
DialogScrollGetDefaultSize(item, &width, &height);
set_slot_value(item, s_size, integer_list_2(width, height));
}
return(item);
}
/* :VALUE Method */
LVAL xsscroll_item_value()
{
LVAL item;
int set, value;
item = xsgetscrollitem();
set = moreargs();
if (set) value = getfixnum(xlgafixnum());
xllastarg();
return(DialogScrollItemValue(item, set, value));
}
/* :MAX Method */
LVAL xsscroll_item_max()
{
LVAL item;
int set, value;
item = xsgetscrollitem();
set = moreargs();
if (set) value = getfixnum(xlgafixnum());
xllastarg();
return(DialogScrollItemMax(item, set, value));
}
/* :MIN Method */
LVAL xsscroll_item_min()
{
LVAL item;
int set, value;
item = xsgetscrollitem();
set = moreargs();
if (set) value = getfixnum(xlgafixnum());
xllastarg();
return(DialogScrollItemMin(item, set, value));
}
/* :SCROLL-ACTION Method */
LVAL xsscroll_item_action()
{
LVAL item, action/*, result rewritten JKL*/;
item = xsgetdialogitem();
xllastarg();
action = slot_value(item, s_action);
/* result = (action != NIL) ? xlapply(pushargs(action, NIL)) : NIL;*/
return(/*result*/(action != NIL) ? xlapply(pushargs(action, NIL)) : NIL);
}
/***********************************************************************/
/***********************************************************************/
/** **/
/** LIST-ITEM-PROTO Methods **/
/** **/
/***********************************************************************/
/***********************************************************************/
/* Is this a list-item? */
int list_item_p(x)
LVAL x;
{
return (kind_of_p(x, getvalue(s_list_item_proto)));
}
/* get a list item from the stack */
LVAL xsgetlistitem()
{
LVAL x;
x = xlgetarg();
if (! list_item_p(x)) xlerror("not a list item", x);
return(x);
}
/* :ISNEW Method */
LVAL xslist_item_isnew()
{
LVAL item, data, columns;
int width, height;
item = xsgetlistitem();
data = xlgetarg();
if (listp(data)) data = coerce_to_vector(data);
else data = copyarray(data);
set_slot_value(item, s_list_data, data);
get_initial_item_values(item, FALSE);
if (! xlgetkeyarg(sk_columns, &columns) || ! fixp(columns)
|| getfixnum(columns) < 1) columns = cvfixnum((FIXTYPE) 1);
set_slot_value(item, s_columns, columns);
if (! has_item_size(item)) {
DialogListGetDefaultSize(item, &width, &height);
set_slot_value(item, s_size, integer_list_2(width, height));
}
return(item);
}
/* :DO-ACTION Method */
LVAL xslist_item_action()
{
LVAL item, action, double_click/*, result rewritten JKL*/;
item = xsgetlistitem();
double_click = (moreargs() && xlgetarg() != NIL) ? s_true : NIL;
xllastarg();
action = slot_value(item, s_action);
/* result = (action != NIL) ? xsfuncall1(action, double_click) : NIL;*/
return(/*result*/(action != NIL) ? xsfuncall1(action, double_click) : NIL);
}
/* :SET-TEXT Method */
LVAL xslist_item_text()
{
LVAL item, data, index, value;
char *text;
item = xsgetlistitem();
index = xlgetarg();
value = xlgastring();
text = (char *) getstring(value);
xllastarg();
data = slot_value(item, s_list_data);
if (simplevectorp(data))
setelement(data, rowmajorindex(data, consa(index), FALSE), value);
else if (arrayp(data))
setelement(arraydata(data), rowmajorindex(data, index, FALSE), value);
else xlerror("not an array", data);
DialogListItemSetText(item, index, text);
return(NIL);
}
/* :SELECTION Method */
LVAL xslist_item_selection()
{
LVAL item, index;
int set;
item = xsgetlistitem();
set = moreargs();
if (set) index = xlgetarg();
xllastarg();
return(DialogListItemSelection(item, set, index));
}