/*
 *   GRacer
 *
 *   Copyright (C) 1999 Takashi Matsuda <matsu@users.sourceforge.net>
 *
 * This program is free software; you can redistribute it and/or 
 * modify it under the terms of the GNU General Public License as 
 * published by the Free Software Foundation; either version 2 of the
 * License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
 * USA
 */

#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <GL/glut.h>
#include <common/gr_memory.h>
#include "tcldefs.h"
#include "glutwidgets.h"
#include "gluttclwidgets.h"
#include "glbind.h"
#include <common/gr_debug.h>

static Tcl_HashTable widget_hash;

static int
Tcl_InvokeCallback (Tcl_Interp *interp, Tcl_Obj *script) {
  int res;

  Tcl_IncrRefCount (script);
  if ((res = Tcl_EvalObj (interp, script)) == TCL_ERROR) {
    fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
  }
  Tcl_DecrRefCount (script);

  return res;
}

GlutObject
Tcl_GetGlutObject (Tcl_Interp *interp, Tcl_Obj *CONST obj)
{
  char *str;
  Tcl_HashEntry *entry;

  str = Tcl_GetStringFromObj (obj, NULL);
  entry = Tcl_FindHashEntry (&widget_hash, str);
  if (entry) {
    return (GlutObject) Tcl_GetHashValue (entry);
  } else {
    return NULL;
  }
}

static void
glut_tcl_root_display (GlutObject obj)
{
  GlutTclRoot *root = obj;

  if (!root->display_interp || !root->display_script)
    return;

  Tcl_InvokeCallback (root->display_interp, root->display_script);
}

static void
glut_tcl_root_reshape (GlutObject obj, int width, int height)
{
  GlutTclRoot *root = obj;
  Tcl_Interp *interp = root->reshape_interp;

  if (!interp || !root->reshape_script)
    return;

  Tcl_ObjSetVar2 (interp, obj_width, NULL, Tcl_NewIntObj (width), 0);
  Tcl_ObjSetVar2 (interp, obj_width, NULL, Tcl_NewIntObj (width), 0);

  Tcl_InvokeCallback (interp, root->reshape_script);
}

int
Tcl_GlutRootConfigure (Tcl_Interp *interp, GlutObject obj,
    			 int objc, Tcl_Obj *CONST objv[])
{
  GlutTclRoot *root = obj;
  char *str;
  int i;
  int length = 0;

  for (i=0; i<objc;) {
    str = Tcl_GetStringFromObj (objv[i], NULL);
    if (!strcmp (str, "-display")) {
      if (i+1==objc) {
	Tcl_AppendResult (interp,
	    ": wrong # args. should be -display script | -display {}.", NULL);
	return TCL_ERROR;
      }
      if (root->display_script) {
	Tcl_DecrRefCount (root->display_script);
      }

      Tcl_ListObjLength (interp, objv[i+1], &length);
      if (length > 0) {
	root->core.display_func = glut_tcl_root_display;
	root->display_script = objv[i+1];
	Tcl_IncrRefCount (root->display_script);
	//root->display_script = Tcl_DuplicateObj (objv[i+1]);
	root->display_interp = interp;
      } else {
	root->core.display_func = NULL;
	root->display_script = NULL;
	root->display_interp = NULL;
      }
      i+=2;
    } else if (!strcmp (str, "-reshape")) {
      if (i+1==objc) {
	Tcl_AppendResult (interp,
	    ": wrong # args. should be -reshape script | -reshape {}.", NULL);
	return TCL_ERROR;
      }
      if (root->reshape_script) {
	Tcl_DecrRefCount (root->reshape_script);
      }

      Tcl_ListObjLength (interp, objv[i+1], &length);
      if (length > 0) {
	root->core.reshape_func = glut_tcl_root_reshape;
	root->reshape_script = objv[i+1];
	Tcl_IncrRefCount (root->reshape_script);
	//root->reshape_script = Tcl_DuplicateObj (objv[i+1]);
	root->reshape_interp = interp;
      } else {
	root->core.reshape_func = NULL;
	root->reshape_script = NULL;
	root->reshape_interp = NULL;
      }
      i+=2;
    } else {
      Tcl_AppendResult (interp,
	  ": unknown args. should -display script, or -display {}.", NULL);
      return TCL_ERROR;
    }
  }
  return TCL_OK;
}

static int
Tcl_GlutRootCmd (ClientData data, Tcl_Interp *interp,
    		   int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj = data;

  if (!obj) {
    OBJ_RESULT (objv[0], ": internal error. widget does not managed.");
    return TCL_ERROR;
  }
  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (!strcmp (str, "configure")) {
    Tcl_SetObjResult (interp, objv[0]);
    return Tcl_GlutRootConfigure (interp, obj, objc-2, objv+2);
  }

  OBJ_RESULT (objv[0], ": wrong args. should be configure ...");
  return TCL_ERROR;
}

static void
tcl_glutroot_destroy (GlutObject obj)
{
  GlutTclRoot *root = obj;

  if (root->display_script) {
    Tcl_DecrRefCount (root->display_script);
    root->display_script = NULL;
  }

  if (root->reshape_script) {
    Tcl_DecrRefCount (root->reshape_script);
    root->reshape_script = NULL;
  }

  Tcl_DeleteCommandFromToken (root->interp, root->token);

  glut_root_destroy (obj);
}

static int
Tcl_GlutRootCreateCmd (ClientData data, Tcl_Interp *interp,
			 int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;
  GlutTclRoot *root;
  int res;

  Tcl_SetObjResult (interp, objv[0]);

  if (objc < 2) {
    Tcl_AppendResult (interp, ": wrong # args. should be <name> ...", NULL);
    return TCL_ERROR;
  }

  obj = gr_new0 (GlutTclRoot, 1);
  root = obj;
  glut_root_init (obj);
  gr_FREE_FUNC (obj, tcl_glutroot_destroy);

  res = Tcl_GlutRootConfigure (interp, obj, objc-2, objv+2);
  if (res == TCL_ERROR) {
    free (obj);
    return TCL_ERROR;
  }

  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (Tcl_GlutWidgetInsertHash (interp, obj, str) == TCL_ERROR) {
    free (obj);
    return TCL_ERROR;
  }

  root->token = Tcl_CreateObjCommand (interp, str, Tcl_GlutRootCmd,
				      (ClientData) root, NULL);
  root->interp = interp;

  return TCL_OK;
}

static int
Tcl_GetGlutWidgetState (Tcl_Interp *interp, Tcl_Obj *CONST obj)
{
  char *str;
  int state = 0;

  str = Tcl_GetStringFromObj (obj, NULL);
  if (!strcmp (str, "normal")) {
    state = GR_STATE_NORMAL;
  } else if (!strcmp (str, "active")) {
    state = GR_STATE_ACTIVE;
  } else if (!strcmp (str, "focus")) {
    state = GR_STATE_FOCUS;
  } else if (!strcmp (str, "grab")) {
    state = GR_STATE_GRAB;
  } else if (!strcmp (str, "disable")) {
    state = GR_STATE_DISABLE;
  }

  return state;
}

int
Tcl_GlutWidgetInsertHash (Tcl_Interp *interp, GlutObject obj, char *key)
{
  Tcl_HashEntry *entry;
  int _new;

  entry = Tcl_CreateHashEntry (&widget_hash, key, &_new);
  if (!entry) {
    return TCL_ERROR;
  }
  Tcl_SetHashValue (entry, (ClientData) obj);
  Tcl_AppendResult (interp, key, NULL);

  return TCL_OK;
}

int
Tcl_GlutWidgetDeleteHash (Tcl_Interp *interp, char *key)
{
  Tcl_HashEntry *entry;

  entry = Tcl_FindHashEntry (&widget_hash, key);
  if (!entry) {
    return TCL_OK;
  }
  Tcl_DeleteHashEntry (entry);

  return TCL_OK;
}

static int
Tcl_SetGlutWidgetColor (Tcl_Interp *interp,
    			GLfloat color[][4],
    			int objc, Tcl_Obj *CONST objv[])
{
  int state;
  double c[4];

  if (objc < 4) {
    Tcl_AppendResult (interp, "wrong # args. should be r g b [a].", NULL);
    return 0;
  }
  state = Tcl_GetGlutWidgetState (interp, objv[0]);

  TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &c[0]), ERROR);
  TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &c[1]), ERROR);
  TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &c[2]), ERROR);
  if (objc < 5 ||
      Tcl_GetDoubleFromObj (interp, objv[4], &c[3]) == TCL_ERROR) {
    color[state][0] = c[0];
    color[state][1] = c[1];
    color[state][2] = c[2];
    color[state][3] = 1.0;
    return 4;
  } else {
    color[state][0] = c[0];
    color[state][1] = c[1];
    color[state][2] = c[2];
    color[state][3] = c[3];
    return 5;
  }

ERROR:
  return 0;
}

int
Tcl_GlutWidgetConfigure (Tcl_Interp *interp,
    			 GlutObject obj,
			 int objc,
			 Tcl_Obj *CONST objv[])
{
  GlutWidget *widget = obj;
  char *str;
  int res;
  void *font;
  int x, y, width, height;
  int anchor = 0;

  str = Tcl_GetStringFromObj (objv[0], NULL);
  if (!strcmp (str, "-fgcolor")) {
    res = Tcl_SetGlutWidgetColor (interp, widget->fg_color, objc-1, objv+1);
    if (res == 0) {
      return 0;
    }
    return res + 1;
  } else if (!strcmp (str, "-bgcolor")) {
    res = Tcl_SetGlutWidgetColor (interp, widget->bg_color, objc-1, objv+1);
    if (res == 0) {
      return 0;
    }
    return res + 1;
  } else if (!strcmp (str, "-font")) {
    if (objc < 2) {
      Tcl_AppendResult (interp, ": wrong # args. should be -font <font name>.",
	  		NULL);
      return 0;
    }
    font = GetGlutEnum (objv[1]);
    if (font) {
      glut_widget_set_font (widget, font);
      return 2;
    } else {
      Tcl_AppendResult (interp, ": font name is wrong.", NULL);
      return 0;
    }
  } else if (!strcmp (str, "-size")) {
    if (objc < 3) {
      Tcl_AppendResult (interp, ": wrong # args. should be -size w h.", NULL);
      return 0;
    }
    TCL_CHECK(Tcl_GetIntFromObj(interp, objv[1], &width), ERROR);
    TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &height), ERROR);

    glut_widget_set_size (widget, width, height);
    return 3;
  } else if (!strcmp (str, "-pos")) {
    if (objc < 4) {
      Tcl_AppendResult (interp,
	  ": wrong # args. should be -pos x y anchor", NULL);
      return 0;
    }
    TCL_CHECK(Tcl_GetIntFromObj(interp, objv[1], &x), ERROR);
    TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &y), ERROR);
    str = Tcl_GetStringFromObj (objv[3], NULL);
    if (!strcmp (str, "center")) {
      anchor = GR_CENTER;
    } else {
      if (strchr (str, 'n'))
	anchor |= GR_TOP;
      if (strchr (str, 's'))
	anchor |= GR_BOTTOM;
      if (strchr (str, 'w'))
	anchor |= GR_LEFT;
      if (strchr (str, 'e'))
	anchor |= GR_RIGHT;
    }
    glut_widget_set_position (widget, x, y, anchor);
    return 4;
  }

ERROR:
  return 0;
}

static void
glut_tcl_button_invoke (GlutObject obj)
{
  GlutTclButton *button = obj;

  if (!button->invoke_interp || !button->invoke_script)
    return;

  Tcl_InvokeCallback (button->invoke_interp, button->invoke_script);
}

int
Tcl_GlutButtonConfigure (Tcl_Interp *interp, GlutObject obj,
    			 int objc, Tcl_Obj *CONST objv[])
{
  Tcl_Obj *res_obj;
  GlutTclButton *button = obj;
  char *str;
  int i;
  int res;
  int length;

  for (i=0; i<objc;) {
    str = Tcl_GetStringFromObj (objv[i], NULL);
    if (!strcmp (str, "-command")) {
      if (i+1==objc) {
	Tcl_AppendResult (interp,
	    ": wrong # args. should be -command script | -command {}.", NULL);
	return TCL_ERROR;;
      }
      if (button->invoke_script) {
	Tcl_DecrRefCount (button->invoke_script);
	button->core.invoke_func = NULL;
      }

      Tcl_ListObjLength (interp, objv[i+1], &length);
      if (length > 0) {
	button->invoke_script = objv[i+1];
	Tcl_IncrRefCount (objv[i+1]);
	button->core.invoke_func = glut_tcl_button_invoke;
	button->invoke_interp = interp;
      } else {
	button->invoke_script = NULL;
      }
      i+=2;
    } else if (!strcmp (str, "-text")) {
      if (i+1==objc) {
	res_obj = Tcl_NewStringObj (button->core.title, button->core.length);
	Tcl_SetObjResult (interp, res_obj);
	return TCL_OK;
      } else {
	str = Tcl_GetStringFromObj (objv[i+1], NULL);
	glut_button_set_text (button, str);
	i+=2;
      }
    } else {
      res = Tcl_GlutWidgetConfigure (interp, obj, objc-i, objv+i);
      if (res == 0) {
	return TCL_ERROR;
      }
      i += res;
    }
  }
  return TCL_OK;
}

static int
Tcl_GlutButtonCmd (ClientData data, Tcl_Interp *interp,
    		   int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;

  obj = Tcl_GetGlutObject (interp, objv[0]);
  if (!obj) {
    OBJ_RESULT (objv[0], ": internal error. widget does not managed.");
    return TCL_ERROR;
  }
  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (!strcmp (str, "configure")) {
    Tcl_SetObjResult (interp, objv[0]);
    return Tcl_GlutButtonConfigure (interp, obj, objc-2, objv+2);
  } else if (!strcmp (str, "invoke")) {
    glut_button_invoke (obj);
    return TCL_OK;
  }

  OBJ_RESULT (objv[0], ": wrong args. should be configure ... | invoke.");
  return TCL_ERROR;
}

static void
tcl_glutbutton_destroy (GlutObject obj)
{
  GlutTclButton *button = obj;

  if (button->invoke_script) {
    Tcl_DecrRefCount (button->invoke_script);
  }
  Tcl_DeleteCommand (button->interp, button->command_name);
  free (button->command_name);

  glut_button_destroy (obj);
}

static int
Tcl_GlutButtonCreateCmd (ClientData data, Tcl_Interp *interp,
			 int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;
  GlutRoot *root;
  GlutTclButton *button;
  int res;

  Tcl_SetObjResult (interp, objv[0]);

  if (objc < 2) {
    Tcl_AppendResult (interp, ": wrong # args. should be <name> ...", NULL);
    return TCL_ERROR;
  }

  obj = gr_new0 (GlutTclButton, 1);
  root = obj;
  button = obj;
  glut_button_init (obj);
  gr_FREE_FUNC (obj, tcl_glutbutton_destroy);

  res = Tcl_GlutButtonConfigure (interp, obj, objc-2, objv+2);
  if (res == TCL_ERROR) {
    free (obj);
    return TCL_ERROR;
  }

  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (Tcl_GlutWidgetInsertHash (interp, obj, str) == TCL_ERROR) {
    free (obj);
    return TCL_ERROR;
  }

  Tcl_CreateObjCommand (interp, str, Tcl_GlutButtonCmd, NULL, NULL);
  button->interp = interp;
  button->command_name = strdup (str);

  Tcl_SetResult (interp, button->command_name, TCL_VOLATILE);

  return TCL_OK;
}

static void
glut_tcl_entry_invoke (GlutObject obj)
{
  GlutTclEntry *entry = obj;

  if (Tcl_InvokeCallback (entry->invoke_interp, entry->invoke_script) == TCL_ERROR) {
     fputs (Tcl_GetVar (entry->invoke_interp, "errorInfo", TCL_GLOBAL_ONLY),
	    stderr);
  }
}

static void
glut_tcl_entry_changed (GlutObject obj)
{
  GlutTclEntry *entry = obj;

  if (Tcl_InvokeCallback (entry->changed_interp, entry->changed_script) == TCL_ERROR) {
     fputs (Tcl_GetVar (entry->changed_interp, "errorInfo", TCL_GLOBAL_ONLY),
	    stderr);
  }
}

int
Tcl_GlutEntryConfigure (Tcl_Interp *interp, GlutObject obj,
    			 int objc, Tcl_Obj *CONST objv[])
{
  GlutTclEntry *entry = obj;
  Tcl_Obj *res_obj;
  char *str;
  int i;
  int res;
  int length;

  for (i=0; i<objc;) {
    str = Tcl_GetStringFromObj (objv[i], NULL);
    if (!strcmp (str, "-command")) {
      if (i+1==objc) {
	Tcl_AppendResult (interp,
	    ": wrong # args. should be -command script | -command {}.", NULL);
	return TCL_ERROR;;
      }
      if (entry->invoke_script) {
	Tcl_DecrRefCount (entry->invoke_script);
	entry->core.invoke_func = NULL;
      }

      Tcl_ListObjLength (interp, objv[i+1], &length);
      if (length > 0) {
	entry->invoke_script = objv[i+1];
	Tcl_IncrRefCount (objv[i+1]);
	entry->core.invoke_func = glut_tcl_entry_invoke;
	entry->invoke_interp = interp;
      } else {
	entry->invoke_script = NULL;
      }
      i+=2;
    } else if (!strcmp (str, "-changed")) {
      if (i+1==objc) {
	Tcl_AppendResult (interp,
	    ": wrong # args. should be -command script | -command {}.", NULL);
	return TCL_ERROR;;
      }
      if (entry->changed_script) {
	Tcl_DecrRefCount (entry->changed_script);
	entry->core.changed_func = NULL;
      }

      Tcl_ListObjLength (interp, objv[i+1], &length);
      if (length > 0) {
	entry->changed_script = objv[i+1];
	Tcl_IncrRefCount (objv[i+1]);
	entry->core.changed_func = glut_tcl_entry_changed;
	entry->changed_interp = interp;
      } else {
	entry->changed_script = NULL;
      }
      i+=2;
    } else if (!strcmp (str, "-text")) {
      if (i+1==objc) {
	res_obj = Tcl_GetObjResult (interp);
	Tcl_SetStringObj (res_obj, entry->core.text, entry->core.length);
	return TCL_OK;
      } else {
	str = Tcl_GetStringFromObj (objv[i+1], NULL);
	glut_entry_set_text (entry, str);
	i+=2;
      }
    } else {
      res = Tcl_GlutWidgetConfigure (interp, obj, objc-i, objv+i);
      if (res == 0) {
	return TCL_ERROR;
      }
      i += res;
    }
  }
  return TCL_OK;
}

static int
Tcl_GlutEntryCmd (ClientData data, Tcl_Interp *interp,
    		   int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;
  GlutEntry *entry;

  Tcl_SetObjResult (interp, objv[0]);

  obj = Tcl_GetGlutObject (interp, objv[0]);
  if (!obj) {
    Tcl_AppendResult (interp, ": internal error. widget is not managed.", NULL);
    return TCL_ERROR;
  }
  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (!strcmp (str, "configure")) {
    return Tcl_GlutEntryConfigure (interp, obj, objc-2, objv+2);
  } else if (!strcmp (str, "get")) {
    entry = obj;
    Tcl_SetObjResult (interp, Tcl_NewStringObj (entry->text, entry->length));
    return TCL_OK;
  } else if (!strcmp (str, "invoke")) {
    glut_entry_invoke (obj);
    return TCL_OK;
  }

  return TCL_ERROR;
}

static void
tcl_glutentry_destroy (GlutObject obj)
{
  GlutTclEntry *entry = obj;
  if (entry->invoke_script) {
    Tcl_DecrRefCount (entry->invoke_script);
  }
  if (entry->changed_script) {
    Tcl_DecrRefCount (entry->changed_script);
  }
  Tcl_DeleteCommand (entry->interp, entry->command_name);
  free (entry->command_name);

  glut_entry_destroy (obj);
}

static int
Tcl_GlutEntryCreateCmd (ClientData data, Tcl_Interp *interp,
			 int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;
  GlutRoot *root;
  GlutTclEntry *entry;
  int res;

  Tcl_SetObjResult (interp, objv[0]);

  if (objc < 2) {
    Tcl_AppendResult (interp, ": wrong # args. should be <name> ...", NULL);
    return TCL_ERROR;
  }

  obj = gr_new0 (GlutTclEntry, 1);
  root = obj;
  entry = obj;
  glut_entry_init (obj);
  gr_FREE_FUNC (obj, tcl_glutentry_destroy);

  res = Tcl_GlutEntryConfigure (interp, obj, objc-2, objv+2);
  if (res == TCL_ERROR) {
    free (obj);
    return TCL_ERROR;
  }

  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (Tcl_GlutWidgetInsertHash (interp, obj, str) == TCL_ERROR) {
    Tcl_AppendResult (interp, ": internal memory error.", NULL);
    free (obj);
    return TCL_ERROR;
  }

  Tcl_CreateObjCommand (interp, str, Tcl_GlutEntryCmd, NULL, NULL);
  entry->interp = interp;
  entry->command_name = strdup (str);

  Tcl_SetResult (interp, entry->command_name, TCL_VOLATILE);

  return TCL_OK;
}

static void
tcl_glutlabel_destroy (GlutObject obj)
{
  GlutTclLabel *label = obj;

  Tcl_DeleteCommand (label->interp, label->command_name);
  free (label->command_name);

  glut_label_destroy (obj);
}

int
Tcl_GlutLabelConfigure (Tcl_Interp *interp, GlutObject obj,
    			int objc, Tcl_Obj *CONST objv[])
{
  GlutTclLabel *label = obj;
  Tcl_Obj *res_obj;
  char *str;
  int i;
  int res;

  for (i=0; i<objc;) {
    str = Tcl_GetStringFromObj (objv[i], NULL);
    if (!strcmp (str, "-text")) {
      if (i+1==objc) {
	res_obj = Tcl_GetObjResult (interp);
	Tcl_SetStringObj (res_obj, label->core.title, label->core.length);
	return TCL_OK;
      } else {
	str = Tcl_GetStringFromObj (objv[i+1], NULL);
	glut_label_set_text (label, str);
	i+=2;
      }
    } else if (!strcmp (str, "-justify")) {
      if (i+1==objc) {
	Tcl_AppendResult (interp,
	    "rong # args. should be -jusify {left|right|center}.", NULL);
	return TCL_ERROR;
      }
      str = Tcl_GetStringFromObj (objv[i+1], NULL);
      if (!strcmp (str, "center")) {
	label->core.justify = GR_CENTER;
      } else if (!strcmp (str, "left")) {
	label->core.justify = GR_LEFT;
      } else if (!strcmp (str, "right")) {
	label->core.justify = GR_RIGHT;
      } else {
	Tcl_AppendResult (interp,
	    "rong # args. should be -jusify {left|right|center}.", NULL);
	return TCL_ERROR;
      }
      i += 2;
    } else {
      res = Tcl_GlutWidgetConfigure (interp, obj, objc-i, objv+i);
      if (res == 0) {
	return TCL_ERROR;
      }
      i += res;
    }
  }
  return TCL_OK;
}

static int
Tcl_GlutLabelCmd (ClientData data, Tcl_Interp *interp,
    		  int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;

  Tcl_SetObjResult (interp, objv[0]);

  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (!strcmp (str, "configure")) {
    obj = Tcl_GetGlutObject (interp, objv[0]);
    return Tcl_GlutLabelConfigure (interp, obj, objc-2, objv+2);
  }

  Tcl_AppendResult (interp, ": wrong # args. should be configure ...", NULL);
  return TCL_ERROR;
}

static int
Tcl_GlutLabelCreateCmd (ClientData data, Tcl_Interp *interp,
			int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;
  GlutRoot *root;
  GlutTclLabel *label;
  int res;

  Tcl_SetObjResult (interp, objv[0]);

  if (objc < 2) {
    Tcl_AppendResult (interp, ": wrong # args. should be <name> ...", NULL);
    return TCL_ERROR;
  }

  obj = gr_new0 (GlutTclLabel, 1);
  root = obj;
  label = obj;
  glut_label_init (obj);
  gr_FREE_FUNC (obj, tcl_glutlabel_destroy);

  res = Tcl_GlutLabelConfigure (interp, obj, objc-2, objv+2);
  if (res == TCL_ERROR) {
    free (obj);
    return TCL_ERROR;
  }

  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (Tcl_GlutWidgetInsertHash (interp, obj, str) == TCL_ERROR) {
    Tcl_AppendResult (interp, ": internal memory error.");
    free (obj);
    return TCL_ERROR;
  }
  Tcl_CreateObjCommand (interp, str, Tcl_GlutLabelCmd, NULL, NULL);
  label->interp = interp;
  label->command_name = strdup (str);

  Tcl_SetResult (interp, label->command_name, TCL_VOLATILE);

  return TCL_OK;
}

static int
Tcl_GlutWidgetCmd (ClientData data, Tcl_Interp *interp,
    		   int objc, Tcl_Obj *CONST objv[])
{
  char *str;
  GlutObject obj;
  GlutObject after;
  GlutWidget *widget;
  int i;
  int res;
  int dx, dy;
  char buf[256];

  if (objc < 2)
    goto ERROR;

  str = Tcl_GetStringFromObj (objv[1], NULL);
  if (!strcmp (str, "forget")) {
    glut_forget_all ();
    return TCL_OK;
  } else if (!strcmp (str, "size")) {
    sprintf (buf, "%d %d", screen_width, screen_height);
    Tcl_AppendResult (interp, buf, NULL);
    return TCL_OK;
  } else if (!strcmp (str, "width")) {
    sprintf (buf, "%d", screen_width);
    Tcl_AppendResult (interp, buf, NULL);
    return TCL_OK;
  } else if (!strcmp (str, "height")) {
    sprintf (buf, "%d", screen_height);
    Tcl_AppendResult (interp, buf, NULL);
    return TCL_OK;
  } else {
    if (objc < 3)
      goto ERROR;

    widget = obj = Tcl_GetGlutObject (interp, objv[2]);
    if (!obj) {
      Tcl_SetObjResult (interp, objv[0]);
      Tcl_AppendResult (interp, ": wrong widget. \"",
	  		Tcl_GetStringFromObj (objv[2], NULL),
			"\" is not defined.", NULL);
      return TCL_ERROR;
    }
    if (!strcmp (str, "configure")) {
      Tcl_SetObjResult (interp, objv[0]);
      for (i=3; i<objc; i++) {
	res = Tcl_GlutWidgetConfigure (interp, obj, objc-i, objv+i);
	if (res == 0) {
	  return TCL_ERROR;
	}
	i += res;
      }
      return TCL_OK;
    } else if (!strcmp (str, "append")) {
      glut_append_object (obj);
      return TCL_OK;
    } else if (!strcmp (str, "prepend")) {
      glut_prepend_object (obj);
      return TCL_OK;
    } else if (!strcmp (str, "insert")) {
      after = Tcl_GetGlutObject (interp, objv[3]);
      return TCL_OK;
      glut_insert_object (obj, after);
    } else if (!strcmp (str, "remove")) {
      glut_remove_object (obj);
      return TCL_OK;
    } else if (!strcmp (str, "move")) {
      if (objc < 5) {
	OBJ_RESULT (objv[0], ":wrong # args. should be move <w> dx dy.");
	return TCL_ERROR;
      }
      Tcl_GetIntFromObj (interp, objv[3], &dx);
      Tcl_GetIntFromObj (interp, objv[4], &dy);
      glut_widget_move (widget, dx, dy);
      return TCL_OK;
    } else if (!strcmp (str, "bbox")) {
      sprintf (buf, "%d %d %d %d",
	       widget->x0, widget->y0, widget->x1, widget->y1);
      Tcl_AppendResult (interp, buf, NULL);
      return TCL_OK;
    } else if (!strcmp (str, "focus")) {
      glut_widget_set_focus (widget);
      return TCL_OK;
    }
  }

ERROR:
  OBJ_RESULT (objv[0],
      ": wrong # args. should be forget, size, width, height, "
      "configure <w> ..., append <w>, prepend <w>, insert <w> <after>, "
      "remove <w>, move <w>, bbox <w>, or focus <w>.");
  return TCL_ERROR;
}

int
GlutTclWidget_Init (Tcl_Interp *interp)
{
  static int do_init = 1;

  if (do_init) {
    do_init = 0;

    Tcl_InitHashTable (&widget_hash, TCL_STRING_KEYS);
  }

  Tcl_CreateObjCommand (interp, "glutwidget",
			Tcl_GlutWidgetCmd, NULL, NULL);
  Tcl_CreateObjCommand (interp, "glutroot",
			Tcl_GlutRootCreateCmd, NULL, NULL);
  Tcl_CreateObjCommand (interp, "glutbutton",
			Tcl_GlutButtonCreateCmd, NULL, NULL);
  Tcl_CreateObjCommand (interp, "glutentry",
			Tcl_GlutEntryCreateCmd, NULL, NULL);
  Tcl_CreateObjCommand (interp, "glutlabel",
			Tcl_GlutLabelCreateCmd, NULL, NULL);

  return TCL_OK;
}