]> git.ipfire.org Git - thirdparty/Python/cpython.git/commitdiff
Initial revision
authorGuido van Rossum <guido@python.org>
Wed, 7 Aug 1991 11:32:58 +0000 (11:32 +0000)
committerGuido van Rossum <guido@python.org>
Wed, 7 Aug 1991 11:32:58 +0000 (11:32 +0000)
Modules/flmodule.c [new file with mode: 0644]

diff --git a/Modules/flmodule.c b/Modules/flmodule.c
new file mode 100644 (file)
index 0000000..4411d87
--- /dev/null
@@ -0,0 +1,2177 @@
+/**********************************************************
+Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
+Netherlands.
+
+                        All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its 
+documentation for any purpose and without fee is hereby granted, 
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in 
+supporting documentation, and that the names of Stichting Mathematisch
+Centrum or CWI not be used in advertising or publicity pertaining to
+distribution of the software without specific, written prior permission.
+
+STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
+THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
+FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
+OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+******************************************************************/
+
+/* FL module -- interface to Mark Overmars' FORMS Library. */
+
+#include "forms.h"
+
+#include "allobjects.h"
+#include "import.h"
+#include "modsupport.h"
+#include "structmember.h"
+
+/* #include "ceval.h" */
+extern object *call_object(object *, object *);
+
+/* Generic Forms Objects */
+
+typedef struct {
+       OB_HEAD
+       FL_OBJECT *ob_generic;
+       struct methodlist *ob_methods;
+       object *ob_callback;
+       object *ob_callback_arg;
+} genericobject;
+
+/* List of all objects (later this should be a hash table on address...) */
+
+static object *allgenerics = NULL;
+
+static void
+knowgeneric(g)
+       genericobject *g;
+{
+       if (allgenerics == NULL) {
+               allgenerics = newlistobject(0);
+               if (allgenerics == NULL) {
+                       err_clear();
+                       return; /* Botte pech */
+               }
+       }
+       addlistitem(allgenerics, (object *)g);
+}
+
+static genericobject *
+findgeneric(generic)
+       FL_OBJECT *generic;
+{
+       int i, n;
+       genericobject *g;
+       
+       if (allgenerics == NULL)
+               return NULL; /* Botte pech */
+       n = getlistsize(allgenerics);
+       for (i = 0; i < n; i++) {
+               g = (genericobject *)getlistitem(allgenerics, i);
+               if (g->ob_generic == generic)
+                       return g;
+       }
+       return NULL; /* Unknown object */
+}
+
+
+/* Methods of generic objects */
+
+static object *
+generic_set_call_back(g, args)
+       genericobject *g;
+       object *args;
+{
+       if (args == NULL) {
+               XDECREF(g->ob_callback);
+               XDECREF(g->ob_callback_arg);
+               g->ob_callback = NULL;
+               g->ob_callback_arg = NULL;
+       }
+       else {
+               if (!is_tupleobject(args) || gettuplesize(args) != 2) {
+                       err_badarg();
+                       return NULL;
+               }
+               XDECREF(g->ob_callback);
+               XDECREF(g->ob_callback_arg);
+               g->ob_callback = gettupleitem(args, 0);
+               INCREF(g->ob_callback);
+               g->ob_callback_arg = gettupleitem(args, 1);
+               INCREF(g->ob_callback_arg);
+       }
+       INCREF(None);
+       return None;
+}
+
+static object *
+generic_call(g, args, func)
+       genericobject *g;
+       object *args;
+       void (*func)(FL_OBJECT *);
+{
+       if (!getnoarg(args))
+               return NULL;
+       (*func)(g->ob_generic);
+       INCREF(None);
+       return None;
+}
+
+static object *
+generic_show_object(g, args)
+       genericobject *g;
+       object *args;
+{
+       return generic_call(g, args, fl_show_object);
+}
+
+static object *
+generic_hide_object(g, args)
+       genericobject *g;
+       object *args;
+{
+       return generic_call(g, args, fl_hide_object);
+}
+
+static object *
+generic_redraw_object(g, args)
+       genericobject *g;
+       object *args;
+{
+       return generic_call(g, args, fl_redraw_object);
+}
+
+static object *
+generic_freeze_object(g, args)
+       genericobject *g;
+       object *args;
+{
+       return generic_call(g, args, fl_freeze_object);
+}
+
+static object *
+generic_unfreeze_object(g, args)
+       genericobject *g;
+       object *args;
+{
+       return generic_call(g, args, fl_unfreeze_object);
+}
+
+static struct methodlist generic_methods[] = {
+       {"set_call_back",       generic_set_call_back},
+       {"show_object",         generic_show_object},
+       {"hide_object",         generic_hide_object},
+       {"redraw_object",       generic_redraw_object},
+       {"freeze_object",       generic_freeze_object},
+       {"unfreeze_object",     generic_unfreeze_object},
+#if 0
+       {"handle_object",       generic_handle_object},
+       {"handle_object_direct",generic_handle_object_direct},
+#endif
+  {NULL,                       NULL}           /* sentinel */
+};
+
+static void
+generic_dealloc(g)
+       genericobject *g;
+{
+       /* XXX can't destroy forms objects !!! */
+       DEL(g);
+}
+
+#define OFF(x) offsetof(FL_OBJECT, x)
+
+static struct memberlist generic_memberlist[] = {
+       {"objclass",    T_INT,          OFF(objclass),  RO},
+       {"type",        T_INT,          OFF(type),      RO},
+       {"boxtype",     T_INT,          OFF(boxtype)},
+       {"x",           T_FLOAT,        OFF(x)},
+       {"y",           T_FLOAT,        OFF(y)},
+       {"w",           T_FLOAT,        OFF(w)},
+       {"h",           T_FLOAT,        OFF(h)},
+       {"col1",        T_INT,          OFF(col1)},
+       {"col2",        T_INT,          OFF(col2)},
+       {"align",       T_INT,          OFF(align)},
+       {"lcol",        T_INT,          OFF(lcol)},
+       {"lsize",       T_FLOAT,        OFF(lsize)},
+       /* "label" is treated specially! */
+       {"lstyle",      T_INT,          OFF(lstyle)},
+       {"pushed",      T_INT,          OFF(pushed),    RO},
+       {"focus",       T_INT,          OFF(focus),     RO},
+       {"belowmouse",  T_INT,          OFF(belowmouse),RO},
+       {"frozen",      T_INT,          OFF(frozen),    RO},
+       {"active",      T_INT,          OFF(active),    RO},
+       {"input",       T_INT,          OFF(input),     RO},
+       {"visible",     T_INT,          OFF(visible),   RO},
+       {"radio",       T_INT,          OFF(radio),     RO},
+       {"automatic",   T_INT,          OFF(automatic), RO},
+       {NULL}  /* Sentinel */
+};
+
+static object *
+generic_getattr(g, name)
+       genericobject *g;
+       char *name;
+{
+       object *meth;
+       
+       if (g-> ob_methods) {
+         meth = findmethod(g->ob_methods, (object *)g, name);
+         if (meth != NULL) return meth;
+         err_clear();
+        }
+
+       meth = findmethod(generic_methods, (object *)g, name);
+       if (meth != NULL)
+               return meth;
+       err_clear();
+
+       /* "label" is an exception, getmember only works for char pointers,
+          not for char arrays */
+       if (strcmp(name, "label") == 0)
+               return newstringobject(g->ob_generic->label);
+
+       return getmember((char *)g->ob_generic, generic_memberlist, name);
+}
+
+static int
+generic_setattr(g, name, v)
+       genericobject *g;
+       char *name;
+       object *v;
+{
+       int ret;
+
+       if (v == NULL) {
+               err_setstr(TypeError, "can't delete forms object attributes");
+               return NULL;
+       }
+
+       /* "label" is an exception: setmember doesn't set strings;
+          and FORMS wants you to call a function to set the label */
+       if (strcmp(name, "label") == 0) {
+               if (!is_stringobject(v)) {
+                       err_setstr(TypeError, "label attr must be string");
+                       return NULL;
+               }
+               fl_set_object_label(g->ob_generic, getstringvalue(v));
+               return 0;
+       }
+
+       ret = setmember((char *)g->ob_generic, generic_memberlist, name, v);
+
+       /* Rather than calling all the various set_object_* functions,
+          we call fl_redraw_object here.  This is sometimes redundant
+          but I doubt that's a big problem */
+       if (ret == 0)
+               fl_redraw_object(g->ob_generic);
+
+       return ret;
+}
+
+typeobject GenericObjecttype = {
+       OB_HEAD_INIT(&Typetype)
+       0,                      /*ob_size*/
+       "generic FORMS object", /*tp_name*/
+       sizeof(genericobject),  /*tp_size*/
+       0,                      /*tp_itemsize*/
+       /* methods */
+       generic_dealloc,        /*tp_dealloc*/
+       0,                      /*tp_print*/
+       generic_getattr,        /*tp_getattr*/
+       generic_setattr,        /*tp_setattr*/
+       0,                      /*tp_compare*/
+       0,                      /*tp_repr*/
+};
+
+static object *
+newgenericobject(generic, methods)
+       FL_OBJECT *generic;
+       struct methodlist *methods;
+{
+       genericobject *g;
+       g = NEWOBJ(genericobject, &GenericObjecttype);
+       if (g == NULL)
+               return NULL;
+       g-> ob_generic = generic;
+       g->ob_methods = methods;
+       g->ob_callback = NULL;
+       g->ob_callback_arg = NULL;
+       knowgeneric(g);
+       return (object *)g;
+}
+
+/**********************************************************************/
+/* Some common calling sequences */
+
+/* void func (object, float) */
+static object *
+call_forms_INf (func, obj, args)
+     void *(*func)(FL_OBJECT *, float);
+     FL_OBJECT *obj;
+     object *args;
+{
+     float parameter;
+
+     if (!getfloatarg (args, &parameter)) return NULL;
+
+     (*func) (obj, parameter);
+
+     INCREF(None);
+     return None;
+}
+
+/* void func (object, float) */
+static object *
+call_forms_INfINf (func, obj, args)
+     void *(*func)(FL_OBJECT *, float, float);
+     FL_OBJECT *obj;
+     object *args;
+{
+     float par1, par2;
+
+     if (!getfloatfloatarg (args, &par1, &par2)) return NULL;
+
+     (*func) (obj, par1, par2);
+
+     INCREF(None);
+     return None;
+}
+
+/* void func (object, int) */
+static object *
+call_forms_INi (func, obj, args)
+     void *(*func)(FL_OBJECT *, int);
+     FL_OBJECT *obj;
+     object *args;
+{
+     int parameter;
+
+     if (!getintarg (args, &parameter)) return NULL;
+
+     (*func) (obj, parameter);
+
+     INCREF(None);
+     return None;
+}
+
+/* void func (object, string) */
+static object *
+call_forms_INstr (func, obj, args)
+     void *(*func)(FL_OBJECT *, char *);
+     FL_OBJECT *obj;
+     object *args;
+{  
+     object *a;
+     
+     if (!getstrarg (args, &a)) return NULL;
+
+     (*func) (obj, getstringvalue (a));
+
+     INCREF(None);
+     return None;
+}
+
+
+/* voide func (object, int, string) */
+static object *
+call_forms_INiINstr (func, obj, args)
+     void *(*func)(FL_OBJECT *, int, char *);
+     FL_OBJECT *obj;
+     object *args;
+
+{
+     object *a;
+     int b;
+     
+     if (!getintstrarg (args, &b, &a)) return NULL;
+
+     (*func) (obj, b, getstringvalue (a));
+
+     INCREF(None);
+     return None;
+}
+
+/* void func (object, float) */
+static object *
+call_forms_INiINi (func, obj, args)
+     void *(*func)(FL_OBJECT *, float, float);
+     FL_OBJECT *obj;
+     object *args;
+{
+     int par1, par2;
+
+     if (!getintintarg (args, &par1, &par2)) return NULL;
+
+     (*func) (obj, par1, par2);
+
+     INCREF(None);
+     return None;
+}
+
+/* int func (object) */
+static object *
+call_forms_Ri (func, obj, args)
+     int (*func)(FL_OBJECT *);
+     FL_OBJECT *obj;
+     object *args;
+{
+     int retval;
+
+     if (!getnoarg(args)) return NULL;
+
+     retval = (*func) (obj);
+
+     return newintobject ((long) retval);
+}
+
+/* char * func (object) */
+static object *
+call_forms_Rstr (func, obj, args)
+     char * (*func)(FL_OBJECT *);
+     FL_OBJECT *obj;
+     object *args;
+{  
+     char *str;
+     
+     if (!getnoarg (args)) return NULL;
+
+     str = (*func) (obj);
+
+     return newstringobject (str);
+}
+
+/* int func (object) */
+static object *
+call_forms_Rf (func, obj, args)
+     float (*func)(FL_OBJECT *);
+     FL_OBJECT *obj;
+     object *args;
+{
+     float retval;
+
+     if (!getnoarg(args)) return NULL;
+
+     retval = (*func) (obj);
+
+     return newfloatobject (retval);
+}
+
+static object *
+call_forms_OUTfOUTf (func, obj, args)
+        void *(*func)(FL_OBJECT *, float *, float *);
+       FL_OBJECT *obj;
+       object *args;
+{
+        float f1, f2;
+       object *arg;
+
+        if (!getnoarg(args)) return NULL;
+
+       (*func) (obj, &f1, &f2);
+       
+       arg = newtupleobject (2);
+       if (arg == NULL) return NULL;
+
+       settupleitem (arg, 0, newfloatobject (f1));
+       settupleitem (arg, 1, newfloatobject (f2));
+       return arg;
+}
+
+static object *
+call_forms_OUTf (func, obj, args)
+        void *(*func)(FL_OBJECT *, float *);
+       FL_OBJECT *obj;
+       object *args;
+{
+        float f;
+       object *arg;
+
+        if (!getnoarg(args)) return NULL;
+
+       (*func) (obj, &f);
+
+       return newfloatobject (f);
+}
+
+/**********************************************************************/
+/* Class : browser */
+
+static object *
+set_browser_topline(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_browser_topline, g-> ob_generic, args);
+}
+
+static object *
+clear_browser(g, args)
+       genericobject *g;
+       object *args;
+{
+  return generic_call (g, args, fl_clear_browser);
+}
+
+static object *
+add_browser_line (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INstr (fl_add_browser_line, g-> ob_generic, args);
+}
+
+static object *
+addto_browser (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INstr (fl_addto_browser, g-> ob_generic, args);
+}
+
+static object *
+insert_browser_line (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INiINstr (fl_insert_browser_line, g-> ob_generic, args);
+}
+
+static object *
+delete_browser_line (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_delete_browser_line, g-> ob_generic, args);
+}
+
+static object *
+replace_browser_line (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INiINstr (fl_replace_browser_line, g-> ob_generic, args);
+}
+
+static object *
+get_browser_line(g, args)
+       genericobject *g;
+       object *args;
+{
+       int i;
+       char *str;
+
+       if (!getintarg(args, &i))
+               return NULL;
+
+       str = fl_get_browser_line (g->ob_generic, i);
+
+       return newstringobject (str);
+}
+
+static object *
+load_browser (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INstr (fl_load_browser, g-> ob_generic, args);
+}
+
+static object *
+get_browser_maxline(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Ri (fl_get_browser_maxline, g-> ob_generic, args);
+}
+
+static object *
+select_browser_line (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_select_browser_line, g-> ob_generic, args);
+}
+
+static object *
+deselect_browser_line (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_deselect_browser_line, g-> ob_generic, args);
+}
+
+static object *
+deselect_browser (g, args)
+       genericobject *g;
+       object *args;
+{
+  return generic_call (g, args, fl_deselect_browser);
+}
+
+static object *
+isselected_browser_line (g, args)
+     genericobject *g;
+     object *args;
+{
+       int i, j;
+       object *arg;
+
+       if (!getintarg(args, &i))
+               return NULL;
+
+       j = fl_isselected_browser_line (g->ob_generic, i);
+
+       return newintobject (j);
+}
+
+static object *
+get_browser (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_Ri (fl_get_browser, g-> ob_generic, args);
+}
+
+static object *
+set_browser_fontsize (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_browser_fontsize, g-> ob_generic, args);
+}
+
+static object *
+set_browser_fontstyle (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_browser_fontstyle, g-> ob_generic, args);
+}
+
+static struct methodlist browser_methods[] = {
+       {"set_browser_topline", set_browser_topline},
+       {"clear_browser",       clear_browser},
+       {"add_browser_line",    add_browser_line},
+       {"addto_browser",       addto_browser},
+       {"insert_browser_line", insert_browser_line},
+       {"delete_browser_line", delete_browser_line},
+       {"replace_browser_line",replace_browser_line},
+       {"get_browser_line",    get_browser_line},
+       {"load_browser",        load_browser},
+       {"get_browser_maxline", get_browser_maxline},
+       {"select_browser_line", select_browser_line},
+       {"deselect_browser_line",   deselect_browser_line},
+       {"deselect_browser",    deselect_browser},
+       {"isselected_browser_line", isselected_browser_line},
+       {"get_browser",         get_browser},
+       {"set_browser_fontsize",set_browser_fontsize},
+       {"set_browser_fontstyle",    set_browser_fontstyle},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Class: button */
+
+static object *
+set_button(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_button, g-> ob_generic, args);
+}
+
+static object *
+get_button(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Ri (fl_get_button, g-> ob_generic, args);
+}
+
+static struct methodlist button_methods[] = {
+       {"set_button",          set_button},
+       {"get_button",          get_button},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Class: choice */
+
+static object *
+set_choice(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_choice, g-> ob_generic, args);
+}
+
+static object *
+get_choice(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Ri (fl_get_choice, g-> ob_generic, args);
+}
+
+static object *
+clear_choice (g, args)
+     genericobject *g;
+     object *args;
+{
+     generic_call (g, args, fl_clear_choice);
+}
+
+static object *
+addto_choice (g, args)
+     genericobject *g;
+     object *args;
+{  
+   return call_forms_INstr (fl_addto_choice, g-> ob_generic, args);
+}
+
+static object *
+replace_choice (g, args)
+     genericobject *g;
+     object *args;
+{  
+  return call_forms_INiINstr (fl_replace_choice, g-> ob_generic, args);
+}
+
+static object *
+delete_choice (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INi (fl_delete_choice, g-> ob_generic, args);
+}
+
+static object *
+get_choice_text (g, args)
+     genericobject *g;
+     object *args;
+{  
+  return call_forms_Rstr (fl_get_choice_text, g-> ob_generic, args);
+}
+
+static object *
+set_choice_fontsize (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INf (fl_set_choice_fontsize, g-> ob_generic, args);
+}
+
+static object *
+set_choice_fontstyle (g, args)
+     genericobject *g;
+     object *args;
+{
+  return call_forms_INi (fl_set_choice_fontstyle, g-> ob_generic, args);
+}
+
+static struct methodlist choice_methods[] = {
+       {"set_choice",          set_choice},
+       {"get_choice",          get_choice},
+       {"clear_choice",        clear_choice},
+       {"addto_choice",        addto_choice},
+       {"replace_choice",      replace_choice},
+       {"delete_choice",       delete_choice},
+       {"get_choice_text",     get_choice_text},
+       {"set_choice_fontsize", set_choice_fontsize},
+       {"set_choice_fontstyle",set_choice_fontstyle},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Class : Clock */
+
+static object *
+get_clock(g, args)
+       genericobject *g;
+       object *args;
+{
+       int i0, i1, i2;
+       object *arg;
+
+       if (!getnoarg(args))
+               return NULL;
+
+       fl_get_clock (g->ob_generic, &i0, &i1, &i2);
+
+       arg = newtupleobject (3);
+       if (arg == NULL) return NULL;
+
+       settupleitem (arg, 0, newintobject (i0));
+       settupleitem (arg, 1, newintobject (i1));
+       settupleitem (arg, 2, newintobject (i2));
+       return arg;
+}
+
+static struct methodlist clock_methods[] = {
+       {"get_clock",           get_clock},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* CLass : Counters */
+
+static object *
+get_counter_value(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rf (fl_get_counter_value, g-> ob_generic, args);
+}
+
+static object *
+set_counter_value (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_counter_value, g-> ob_generic, args);
+}
+
+static object *
+set_counter_precision (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_counter_precision, g-> ob_generic, args);
+}
+
+static object *
+set_counter_bounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_counter_bounds, g-> ob_generic, args);
+}
+
+static object *
+set_counter_step (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_counter_step, g-> ob_generic, args);
+}
+
+static object *
+set_counter_return (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_counter_return, g-> ob_generic, args);
+}
+
+static struct methodlist counter_methods[] = {
+       {"set_counter_value",          set_counter_value},
+       {"get_counter_value",         get_counter_value},
+       {"set_counter_bounds",   set_counter_bounds},
+       {"set_counter_step",   set_counter_step},
+       {"set_counter_precision",   set_counter_precision},
+       {"set_counter_return",   set_counter_return},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Class : Defaults */
+
+static object *
+get_default(g, args)
+       genericobject *g;
+       object *args;
+{
+  char c;
+
+  if (!getnoarg(args)) return NULL;
+
+  c = fl_get_default (g->ob_generic);
+
+  return ((object *) mknewcharobject (c));     /* in cgensupport.c */
+}
+
+static struct methodlist default_methods[] = {
+       {"get_default",       get_default},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+
+/* Class: Dials */
+
+static object *
+set_dial (g, args)
+       genericobject *g;
+       object *args;
+{
+       float f1, f2, f3;
+
+       if (!getfloatfloatfloatarg(args, &f1, &f2, &f3))
+               return NULL;
+       fl_set_dial (g->ob_generic, f1, f2, f3);
+       INCREF(None);
+       return None;
+}
+
+static object *
+get_dial(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rf (fl_get_dial, g-> ob_generic, args);
+}
+
+static object *
+set_dial_value (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_dial_value, g-> ob_generic, args);
+}
+
+static object *
+set_dial_bounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_dial_bounds, g-> ob_generic, args);
+}
+
+static object *
+get_dial_bounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_OUTfOUTf (fl_get_dial_bounds, g-> ob_generic, args);
+}
+
+static struct methodlist dial_methods[] = {
+       {"set_dial",          set_dial},
+       {"get_dial",          get_dial},
+       {"set_dial_value",    set_dial_value},
+       {"get_dial_value",    get_dial},
+       {"set_dial_bounds",   set_dial_bounds},
+       {"get_dial_bounds",   get_dial_bounds},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Class : Input */
+
+static object *
+set_input (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INstr (fl_set_input, g-> ob_generic, args);
+}
+
+static object *
+get_input (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rstr (fl_get_input, g-> ob_generic, args);
+}
+
+static object *
+set_input_color (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_input_color, g-> ob_generic, args);
+}
+
+static struct methodlist input_methods[] = {
+       {"set_input",         set_input},
+       {"get_input",         get_input},
+       {"set_input_color",   set_input_color},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+
+/* Class : Menu */
+
+static object *
+set_menu (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INstr (fl_set_menu, g-> ob_generic, args);
+}
+
+static object *
+get_menu (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Ri (fl_get_menu, g-> ob_generic, args);
+}
+
+static object *
+addto_menu (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INstr (fl_addto_menu, g-> ob_generic, args);
+}
+
+static struct methodlist menu_methods[] = {
+       {"set_menu",         set_menu},
+       {"get_menu",         get_menu},
+       {"addto_menu",       addto_menu},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+
+/* Class: Sliders */
+
+static object *
+set_slider (g, args)
+       genericobject *g;
+       object *args;
+{
+       float f1, f2, f3;
+
+       if (!getfloatfloatfloatarg(args, &f1, &f2, &f3))
+               return NULL;
+       fl_set_slider (g->ob_generic, f1, f2, f3);
+       INCREF(None);
+       return None;
+}
+
+static object *
+get_slider(g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rf (fl_get_slider, g-> ob_generic, args);
+}
+
+static object *
+set_slider_value (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_slider_value, g-> ob_generic, args);
+}
+
+static object *
+set_slider_bounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_slider_bounds, g-> ob_generic, args);
+}
+
+static object *
+get_slider_bounds (g, args)
+       genericobject *g;
+       object *args;
+{
+       return call_forms_OUTfOUTf(fl_get_slider_bounds, g-> ob_generic, args);
+}
+
+static object *
+set_slider_return (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_slider_return, g-> ob_generic, args);
+}
+
+static object *
+set_slider_size (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_slider_size, g-> ob_generic, args);
+}
+
+static object *
+set_slider_precision (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INi (fl_set_slider_precision, g-> ob_generic, args);
+}
+
+static struct methodlist slider_methods[] = {
+       {"set_slider",          set_slider},
+       {"get_slider",          get_slider},
+       {"set_slider_value",    set_slider_value},
+       {"get_slider_value",    get_slider},
+       {"set_slider_bounds",   set_slider_bounds},
+       {"get_slider_bounds",   get_slider_bounds},
+       {"set_slider_return",   set_slider_return},
+       {"set_slider_size",     set_slider_size},
+       {"set_slider_precision",set_slider_precision},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+static object *
+set_positioner_xvalue (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_positioner_xvalue, g-> ob_generic, args);
+}
+
+static object *
+set_positioner_xbounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_positioner_xbounds, g-> ob_generic, args);
+}
+
+static object *
+set_positioner_yvalue (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_positioner_yvalue, g-> ob_generic, args);
+}
+
+static object *
+set_positioner_ybounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INfINf (fl_set_positioner_ybounds, g-> ob_generic, args);
+}
+
+static object *
+get_positioner_xvalue (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rf (fl_get_positioner_xvalue, g-> ob_generic, args);
+}
+
+static object *
+get_positioner_xbounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_OUTfOUTf (fl_get_positioner_xbounds, g-> ob_generic, args);
+}
+
+static object *
+get_positioner_yvalue (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rf (fl_get_positioner_yvalue, g-> ob_generic, args);
+}
+
+static object *
+get_positioner_ybounds (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_OUTfOUTf (fl_get_positioner_ybounds, g-> ob_generic, args);
+}
+
+static struct methodlist positioner_methods[] = {
+       {"set_positioner_xvalue",               set_positioner_xvalue},
+       {"set_positioner_yvalue",               set_positioner_yvalue},
+       {"set_positioner_xbounds",              set_positioner_xbounds},
+       {"set_positioner_ybounds",              set_positioner_ybounds},
+       {"get_positioner_xvalue",               get_positioner_xvalue},
+       {"get_positioner_yvalue",               get_positioner_yvalue},
+       {"get_positioner_xbounds",              get_positioner_xbounds},
+       {"get_positioner_ybounds",              set_positioner_ybounds},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Class timer */
+
+static object *
+set_timer (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_INf (fl_set_timer, g-> ob_generic, args);
+}
+
+static object *
+get_timer (g, args)
+       genericobject *g;
+       object *args;
+{
+  return call_forms_Rf (fl_get_timer, g-> ob_generic, args);
+}
+
+static struct methodlist timer_methods[] = {
+       {"set_timer",           set_timer},
+       {"get_timer",           get_timer},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+/* Form objects */
+
+typedef struct {
+       OB_HEAD
+       FL_FORM *ob_form;
+} formobject;
+
+extern typeobject Formtype; /* Forward */
+
+#define is_formobject(v) ((v)->ob_type == &Formtype)
+
+static object *
+form_show_form(f, args)
+       formobject *f;
+       object *args;
+{
+       int place, border;
+       object *name;
+       if (!getintintstrarg(args, &place, &border, &name))
+               return NULL;
+       fl_show_form(f->ob_form, place, border, getstringvalue(name));
+       INCREF(None);
+       return None;
+}
+
+static object *
+form_call(func, f, args)
+       FL_FORM *f;
+       object *args;
+       void (*func)(FL_FORM *);
+{
+       if (!getnoarg(args)) return NULL;
+
+       (*func)(f);
+
+       INCREF(None);
+       return None;
+}
+
+static object *
+form_call_INiINi (func, f, args)
+       FL_FORM *f;
+       object *args;
+       void (*func)(FL_FORM *, int, int);
+{
+        int a, b;
+
+        if (!getintintarg(args, &a, &b)) return NULL;
+
+       (*func)(f, a, b);
+
+       INCREF(None);
+       return None;
+}
+
+static object *
+form_hide_form(f, args)
+       formobject *f;
+       object *args;
+{
+       return form_call (fl_hide_form, f-> ob_form, args);
+}
+
+static object *
+form_redraw_form(f, args)
+       formobject *f;
+       object *args;
+{ 
+       return form_call (fl_redraw_form, f-> ob_form, args);
+}
+
+static object *
+form_set_form_position (f, args)
+       formobject *f;
+       object *args;
+{
+  return form_call_INiINi (fl_set_form_position, f-> ob_form, args);
+}
+
+static object *
+generic_add_object (f, args, func, internal_methods)
+       formobject *f;
+       object *args;
+       FL_OBJECT *(*func)(int, float, float, float, float, char*);
+        struct methodlist *internal_methods;
+{
+  int type;
+  float x, y, w, h;
+  object *name;
+  FL_OBJECT *genobj;
+
+  if (!getintfloatfloatfloatfloatstr (args,&type,&x,&y,&w,&h,&name))
+    return NULL;
+  
+  fl_addto_form (f-> ob_form);
+  
+  genobj = (*func) (type, x, y, w, h, getstringvalue (name));
+
+  fl_end_form ();
+
+  if (genobj == NULL) { err_nomem(); return NULL; }
+
+  return newgenericobject (genobj, internal_methods);
+}
+
+static object *
+form_add_button(f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_button, button_methods);
+}
+
+static object *
+form_add_lightbutton(f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_lightbutton, button_methods);
+}
+
+static object *
+form_add_roundbutton(f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_roundbutton, button_methods);
+}
+
+static object *
+form_add_menu (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_menu, menu_methods);
+}
+
+static object *
+form_add_slider(f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_slider, slider_methods);
+}
+
+static object *
+form_add_valslider(f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_valslider, slider_methods);
+}
+
+static object *
+form_add_dial (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_dial, dial_methods);
+}
+
+static object *
+form_add_counter (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_counter, counter_methods);
+}
+
+static object *
+form_add_default (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_default, default_methods);
+}
+
+static object *
+form_add_clock (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_clock, clock_methods);
+}
+
+static object *
+form_add_box (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_box, NULL);
+}
+
+static object *
+form_add_choice (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_choice, choice_methods);
+}
+
+static object *
+form_add_browser (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_browser, browser_methods);
+}
+
+static object *
+form_add_positioner (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_positioner, positioner_methods);
+}
+
+static object *
+form_add_input (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_input, input_methods);
+}
+
+static object *
+form_add_text (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_text, NULL);
+}
+
+static object *
+form_add_timer (f, args)
+     formobject *f;
+     object *args;
+{
+       return generic_add_object(f, args, fl_add_timer, timer_methods);
+}
+
+static object *
+form_show_message (f, args)
+     formobject *f;
+     object *args;
+{
+       object *a, *b, *c;
+
+        if (!getstrstrstrarg(args, &a, &b, &c)) return NULL;
+
+       fl_show_message (
+                  getstringvalue(a), getstringvalue(b), getstringvalue(c));
+
+       INCREF (None);
+       return None;
+}
+
+static object *
+form_show_question (f, args)
+     formobject *f;
+     object *args;
+{
+        int ret;
+       object *a, *b, *c;
+
+        if (!getstrstrstrarg(args, &a, &b, &c)) return NULL;
+
+       ret = fl_show_question (
+                  getstringvalue(a), getstringvalue(b), getstringvalue(c));
+   
+        return newintobject ((long) ret);
+}
+
+static object *
+form_show_input (f, args)
+     formobject *f;
+     object *args;
+{
+        char *str;
+       object *a, *b;
+
+        if (!getstrstrarg(args, &a, &b)) return NULL;
+
+       str = fl_show_input (getstringvalue(a), getstringvalue(b));
+   
+        return newstringobject (str);
+}
+
+static object *
+form_file_selector (f, args)
+     formobject *f;
+     object *args;
+{
+        char *str;
+       object *a, *b, *c, *d;
+
+        if (!getstrstrstrstrarg(args, &a, &b, &c, &d)) return NULL;
+
+       str = fl_show_file_selector (getstringvalue(a), getstringvalue(b),
+                                    getstringvalue (c), getstringvalue (d));
+   
+        return newstringobject (str);
+}
+
+
+static object *
+form_file_selector_func (f, args, func)
+     formobject *f;
+     object *args;
+     char *(*func)();
+{
+  char *str;
+  
+  str = (*func) ();
+
+  return newstringobject (str);
+}
+
+static object *
+form_get_directory (f, args)
+     formobject *f;
+     object *args;
+{
+  return form_file_selector_func (f, args, fl_get_directory);
+}
+
+static object *
+form_get_pattern (f, args)
+     formobject *f;
+     object *args;
+{
+  return form_file_selector_func (f, args, fl_get_pattern);
+}
+
+static object *
+form_get_filename (f, args)
+     formobject *f;
+     object *args;
+{
+  return form_file_selector_func (f, args, fl_get_filename);
+
+}
+
+static object *
+form_freeze_form(f, args)
+       formobject *f;
+       object *args;
+{
+       return form_call (fl_freeze_form, f-> ob_form, args);  
+}
+
+static object *
+form_unfreeze_form(f, args)
+       formobject *f;
+       object *args;
+{
+       return form_call (fl_unfreeze_form, f-> ob_form, args);
+}
+
+static object *
+form_display_form(f, args)
+       formobject *f;
+       object *args;
+{
+       int place, border;
+       object *name;
+       if (!getintintstrarg(args, &place, &border, &name))
+               return NULL;
+       fl_show_form(f->ob_form, place, border, getstringvalue(name));
+       INCREF(None);
+       return None;
+}
+
+static object *
+form_remove_form(f, args)
+       formobject *f;
+       object *args;
+{
+       return form_call (fl_remove_form, f-> ob_form, args);
+}
+
+static object *
+form_activate_form(f, args)
+       formobject *f;
+       object *args;
+{
+       return form_call (fl_activate_form, f-> ob_form, args);
+}
+
+static object *
+form_deactivate_form(f, args)
+       formobject *f;
+       object *args;
+{
+       return form_call (fl_deactivate_form, f-> ob_form, args);
+}
+
+static struct methodlist form_methods[] = {
+/* adm */
+       {"show_form",           form_show_form},
+       {"hide_form",           form_hide_form},
+       {"redraw_form",         form_redraw_form},
+       {"set_form_position",   form_set_form_position},
+       {"freeze_form",         form_freeze_form},
+       {"unfreeze_form",       form_unfreeze_form},
+       {"display_form",        form_display_form},
+       {"remove_form",         form_remove_form},
+       {"activate_form",       form_activate_form},
+       {"deactivate_form",     form_deactivate_form},
+
+/* basic objects */
+       {"add_button",          form_add_button},
+/*     {"add_bitmap",          form_add_bitmap}, */
+       {"add_lightbutton",     form_add_lightbutton},
+       {"add_roundbutton",     form_add_roundbutton},
+       {"add_menu",            form_add_menu},
+       {"add_slider",          form_add_slider},
+       {"add_positioner",      form_add_positioner},
+       {"add_valslider",       form_add_valslider},
+       {"add_dial",            form_add_dial},
+       {"add_counter",         form_add_counter},
+       {"add_default",         form_add_default},
+       {"add_box",             form_add_box},
+       {"add_clock",           form_add_clock},
+       {"add_choice",          form_add_choice},
+       {"add_browser",         form_add_browser},
+       {"add_input",           form_add_input},
+       {"add_timer",           form_add_timer},
+       {"add_text",            form_add_text},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+static void
+form_dealloc(f)
+       formobject *f;
+{
+       /* XXX can't destroy form objects !!! */
+       DEL(f);
+}
+
+static object *
+form_getattr(f, name)
+       formobject *f;
+       char *name;
+{
+       /* XXX check for data attr's: x, y etc. */
+       return findmethod(form_methods, (object *)f, name);
+}
+
+typeobject Formtype = {
+       OB_HEAD_INIT(&Typetype)
+       0,                      /*ob_size*/
+       "form",                 /*tp_name*/
+       sizeof(formobject),     /*tp_size*/
+       0,                      /*tp_itemsize*/
+       /* methods */
+       form_dealloc,           /*tp_dealloc*/
+       0,                      /*tp_print*/
+       form_getattr,           /*tp_getattr*/
+       0,                      /*tp_setattr*/
+       0,                      /*tp_compare*/
+       0,                      /*tp_repr*/
+};
+
+static object *
+newformobject(form)
+       FL_FORM *form;
+{
+       formobject *f;
+       f = NEWOBJ(formobject, &Formtype);
+       if (f == NULL)
+               return NULL;
+       f->ob_form = form;
+       return (object *)f;
+}
+
+/* The "fl" module */
+static object *
+forms_make_form(dummy, args)
+       object *dummy;
+       object *args;
+{
+       int type;
+       float w, h;
+       FL_FORM *form;
+       if (!getintfloatfloatarg(args, &type, &w, &h))
+               return NULL;
+       form = fl_bgn_form(type, w, h);
+       if (form == NULL) {
+               /* XXX Actually, cannot happen! */
+               err_nomem();
+               return NULL;
+       }
+       fl_end_form();
+       return newformobject(form);
+}
+
+static object *my_event_callback = NULL;
+
+static object *
+forms_set_event_call_back(dummy, args)
+       object *dummy;
+       object *args;
+{
+       my_event_callback = args;
+       XINCREF(args);
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_do_or_check_forms(dummy, args, func)
+       object *dummy;
+       object *args;
+       FL_OBJECT *(*func)();
+{
+       FL_OBJECT *generic;
+       genericobject *g;
+       object *arg, *res;
+       
+       if (!getnoarg(args))
+               return NULL;
+
+       for (;;) {
+               generic = (*func)();
+               if (generic == NULL) {
+                       INCREF(None);
+                       return None;
+               }
+               if (generic == FL_EVENT) {
+                       int dev;
+                       short val;
+                       if (my_event_callback == NULL)
+                               return newintobject(-1);
+                       dev = fl_qread(&val);
+                       arg = newtupleobject(2);
+                       if (arg == NULL)
+                               return NULL;
+                       settupleitem(arg, 0, newintobject((long)dev));
+                       settupleitem(arg, 1, newintobject((long)val));
+                       res = call_object(my_event_callback, arg);
+                       XDECREF(res);
+                       DECREF(arg);
+                       if (res == NULL)
+                               return NULL; /* Callback raised exception */
+                       continue;
+               }
+               g = findgeneric(generic);
+               if (g == NULL) {
+                       err_setstr(RuntimeError,
+                                  "do_forms returns unknown object");
+                       return NULL;
+               }
+               if (g->ob_callback == NULL) {
+                       INCREF(g);
+                       return ((object *) g);
+               }
+               arg = newtupleobject(2);
+               INCREF(g);
+               settupleitem(arg, 0, g);
+               INCREF(g->ob_callback_arg);
+               settupleitem(arg, 1, g->ob_callback_arg);
+               res = call_object(g->ob_callback, arg);
+               XDECREF(res);
+               DECREF(arg);
+               if (res == NULL)
+                       return NULL; /* Callback raised exception */
+       }
+}
+
+static object *
+forms_do_forms (dummy, args)
+       object *dummy;
+       object *args;
+{
+  return forms_do_or_check_forms (dummy, args, fl_do_forms);
+}
+
+static object *
+forms_check_forms (dummy, args)
+       object *dummy;
+       object *args;
+{
+  return forms_do_or_check_forms (dummy, args, fl_check_forms);
+}
+
+static object *
+fl_call(func, args)
+       object *args;
+       void (*func)();
+{
+       if (!getnoarg(args))
+               return NULL;
+       (*func)();
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_bgn_group (dummy, args)
+       object *dummy;
+       object *args;
+{
+       return fl_call (fl_bgn_group, dummy, args);
+}
+
+static object *
+forms_end_group (dummy, args)
+       object *dummy;
+       object *args;
+{
+       return fl_call (fl_end_group, args);
+}
+
+static object *
+forms_qdevice(self, args)
+       object *self;
+       object *args;
+{
+       short arg1 ;
+       if (!getishortarg(args, 1, 0, &arg1))
+               return NULL;
+       fl_qdevice( arg1 );
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_unqdevice(self, args)
+       object *self;
+       object *args;
+{
+       short arg1 ;
+       if (!getishortarg(args, 1, 0, &arg1))
+               return NULL;
+       fl_unqdevice( arg1 );
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_isqueued(self, args)
+       object *self;
+       object *args;
+{
+       int retval;
+       short arg1 ;
+       if (!getishortarg(args, 1, 0, &arg1))
+               return NULL;
+       retval = fl_isqueued( arg1 );
+
+       return newintobject((int) retval);
+}
+
+static object *
+forms_qtest(self, args)
+       object *self;
+       object *args;
+{
+       long retval;
+       retval = fl_qtest( );
+       return newintobject((int) retval);
+}
+
+
+static object *
+forms_qread(self, args)
+       object *self;
+       object *args;
+{
+       long retval;
+       short arg1 ;
+       retval = fl_qread( & arg1 );
+       { object *v = newtupleobject( 2 );
+         if (v == NULL) return NULL;
+         settupleitem(v, 0, newintobject(retval));
+         settupleitem(v, 1, newintobject((long)arg1));
+         return v;
+       }
+}
+
+static object *
+forms_qreset(self, args)
+       object *self;
+       object *args;
+{
+       if (!getnoarg(args)) return NULL;
+
+       forms_qreset();
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_qenter(self, args)
+       object *self;
+       object *args;
+{
+       short arg1 ;
+       short arg2 ;
+       if (!getishortarg(args, 2, 0, &arg1))
+               return NULL;
+       if (!getishortarg(args, 2, 1, &arg2))
+               return NULL;
+       fl_qenter( arg1 , arg2 );
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_color (self, args)
+       object *self;
+       object *args;
+{
+       int arg;
+
+       if (!getintarg(args, &arg)) return NULL;
+
+       fl_color((short) arg);
+
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_mapcolor (self, args)
+       object *self;
+       object *args;
+{
+       int arg0, arg1, arg2, arg3;
+
+       if (!getintintintintarg(args, &arg0, &arg1, &arg2, &arg3))
+             return NULL;
+
+       fl_mapcolor(arg0, (short) arg1, (short) arg2, (short) arg3);
+
+       INCREF(None);
+       return None;
+}
+
+static object *
+forms_getmcolor (self, args)
+       object *self;
+       object *args;
+{
+       int arg, r, g, b;
+       object *v;
+
+       if (!getintarg(args, &arg)) return NULL;
+
+       fl_getmcolor (arg, (short) r, (short)g, (short)b);
+
+       v = newtupleobject(3);
+
+       if (v == NULL) return NULL;
+
+       settupleitem(v, 0, newintobject(r));
+       settupleitem(v, 1, newintobject(g));
+       settupleitem(v, 2, newintobject(b));
+
+       return v;
+}
+
+static object *
+forms_tie(self, args)
+       object *self;
+       object *args;
+{
+       short arg1 ;
+       short arg2 ;
+       short arg3 ;
+       if (!getishortarg(args, 3, 0, &arg1))
+               return NULL;
+       if (!getishortarg(args, 3, 1, &arg2))
+               return NULL;
+       if (!getishortarg(args, 3, 2, &arg3))
+               return NULL;
+       fl_tie( arg1 , arg2 , arg3 );
+       INCREF(None);
+       return None;
+}
+
+static struct methodlist forms_methods[] = {
+/* adm */
+       {"make_form",           forms_make_form},
+       {"bgn_group",           forms_bgn_group},
+       {"end_group",           forms_end_group},
+/* gl support wrappers */
+       {"qdevice",             forms_qdevice},
+       {"unqdevice",           forms_unqdevice},
+       {"isqueued",            forms_isqueued},
+       {"qtest",               forms_qtest},
+       {"qread",               forms_qread},
+/*     {"blkqread",            forms_blkqread},  */
+       {"qreset",              forms_qreset},
+       {"qenter",              forms_qenter},
+       {"tie",         forms_tie},
+/*     {"new_events",          forms_new_events}, */
+       {"color",               forms_color},
+       {"mapcolor",            forms_mapcolor},
+       {"getmcolor",           forms_getmcolor},
+/* interaction */
+       {"do_forms",            forms_do_forms},
+       {"check_forms",         forms_check_forms},
+       {"set_event_call_back", forms_set_event_call_back},
+/* goodies */
+       {"show_message",        form_show_message},
+       {"show_question",       form_show_question},
+       {"file_selector",       form_file_selector},
+       {"get_directory",       form_get_directory},
+       {"get_pattern",         form_get_pattern},
+       {"get_filename",        form_get_filename},
+/*
+       {"show_choice",         form_show_choice},
+       XXX - draw.c
+*/
+       {"show_input",          form_show_input},
+       {NULL,                  NULL}           /* sentinel */
+};
+
+void
+initfl()
+{
+       initmodule("fl", forms_methods);
+       foreground ();
+}
+
+
+/* Support routines */
+
+int
+getintintstrarg(args, a, b, c)
+       object *args;
+       int *a, *b;
+       object **c;
+{
+       if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 3) {
+               err_badarg();
+               return NULL;
+       }
+       return getintarg(gettupleitem(args, 0), a) &&
+               getintarg(gettupleitem(args, 1), b) &&
+               getstrarg(gettupleitem(args, 2), c);
+}
+
+int
+getintfloatfloatarg(args, a, b, c)
+       object *args;
+       int *a;
+       float *b, *c;
+{
+       if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 3) {
+               err_badarg();
+               return NULL;
+       }
+       return getintarg(gettupleitem(args, 0), a) &&
+               getfloatarg(gettupleitem(args, 1), b) &&
+               getfloatarg(gettupleitem(args, 2), c);
+}
+
+int
+getintintintintarg(args, a, b, c, d)
+       object *args;
+       int *a, *b, *c, *d;
+{
+       if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 4) {
+               err_badarg();
+               return NULL;
+       }
+       return getintarg(gettupleitem(args, 0), a) &&
+               getintarg(gettupleitem(args, 1), b) &&
+               getintarg(gettupleitem(args, 2), c) &&
+               getintarg(gettupleitem(args, 3), d);
+}
+
+int
+getfloatarg(args, a)
+       object *args;
+       float *a;
+{
+       double x;
+       if (!getdoublearg(args, &x))
+               return 0;
+       *a = x;
+       return 1;
+}
+
+int
+getintfloatfloatfloatfloatstr (args, type, x, y, w, h, name)
+     object *args;
+     int *type;
+     float *x, *y, *w, *h;
+     object **name;
+{
+       if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 6) {
+               err_badarg();
+               return NULL;
+       }
+       return  getintarg(gettupleitem(args, 0), type) &&
+               getfloatarg(gettupleitem(args, 1), x) &&
+               getfloatarg(gettupleitem(args, 2), y) &&
+               getfloatarg(gettupleitem(args, 3), w) &&
+               getfloatarg(gettupleitem(args, 4), h) &&
+               getstrarg(gettupleitem(args, 5), name);
+}
+
+int
+getfloatfloatfloatarg(args, f1, f2, f3)
+     object *args;
+     float *f1, *f2, *f3;
+{
+        if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 3) {
+               err_badarg();
+               return NULL;
+       }
+       return  getfloatarg(gettupleitem(args, 0), f1) &&
+               getfloatarg(gettupleitem(args, 1), f2) &&
+               getfloatarg(gettupleitem(args, 2), f3);
+}
+
+int
+getfloatfloatarg(args, f1, f2)
+     object *args;
+     float *f1, *f2;
+{
+        if (args == NULL || !is_tupleobject(args) || gettuplesize(args) != 2) {
+               err_badarg();
+               return NULL;
+       }
+       return  getfloatarg(gettupleitem(args, 0), f1) &&
+               getfloatarg(gettupleitem(args, 1), f2);
+}
+
+int
+getstrstrstrarg(v, a, b, c)
+       object *v;
+       object **a;
+       object **b;
+        object **c;
+{
+       if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
+               return err_badarg();
+       }
+       return getstrarg(gettupleitem(v, 0), a) &&
+               getstrarg(gettupleitem(v, 1), b)&&
+               getstrarg(gettupleitem(v, 2), c);
+}
+
+
+int
+getstrstrstrstrarg(v, a, b, c, d)
+       object *v;
+       object **a;
+       object **b;
+        object **c;
+        object **d;
+{
+       if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 4) {
+               return err_badarg();
+       }
+       return getstrarg(gettupleitem(v, 0), a) &&
+               getstrarg(gettupleitem(v, 1), b)&&
+               getstrarg(gettupleitem(v, 2), c) &&
+               getstrarg(gettupleitem(v, 3),d);
+                 
+}