Posted to tcl by dbohdan at Fri Feb 06 21:16:34 GMT 2015view raw
- /*
- * 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 <unistd.h>
- #include <GL/gl.h>
- #include <GL/glut.h>
- #include <string.h>
- #include <stdlib.h>
- #include <ctype.h>
- #include "tcldefs.h"
- #include <common/gr_memory.h>
- #include <common/gr_scene.h>
- #include <common/gr_debug.h>
- #include "glbind.h"
- #include "glhash.h"
- #include "gluthash.h"
- #define ENUM_CHECK(cmd,label) if ((cmd) == GL_NONE) {goto label;}
- Tcl_Interp *main_interp;
- static Tcl_HashTable gl_enum_hash;
- static Tcl_HashTable gl_func_hash;
- static Tcl_HashTable glut_enum_hash;
- static Tcl_HashTable glut_func_hash;
- static Tcl_HashTable cache_hash;
- static Tcl_HashTable scene_hash;
- static Tcl_HashTable glut_timer_hash;
- static TclGlutCallback display_cb;
- static TclGlutCallback reshape_cb;
- static TclGlutCallback keyboard_cb;
- static TclGlutCallback keyboard_up_cb;
- static TclGlutCallback special_cb;
- static TclGlutCallback special_up_cb;
- static TclGlutCallback mouse_cb;
- static TclGlutCallback motion_cb;
- static TclGlutCallback passive_motion_cb;
- static TclGlutCallback entry_cb;
- static TclGlutCallback visibility_cb;
- static TclGlutCallback menu_state_cb;
- static TclGlutCallback tablet_motion_cb;
- static TclGlutCallback tablet_button_cb;
- static TclGlutCallback menu_status_cb;
- static TclGlutCallback window_status_cb;
- static TclGlutCallback idle_cb;
- Tcl_Obj *obj_x;
- Tcl_Obj *obj_y;
- Tcl_Obj *obj_width;
- Tcl_Obj *obj_height;
- Tcl_Obj *obj_state;
- Tcl_Obj *obj_status;
- Tcl_Obj *obj_key;
- Tcl_Obj *obj_button;
- Tcl_Obj *obj_value;
- typedef int (*GrSubCmdFunc)(Tcl_Interp *, int objc, Tcl_Obj *CONST objv[]);
- typedef struct {
- char *name;
- GrSubCmdFunc func;
- int value;
- } GrFunctionList;
- FILE*
- gr_open_file (char *url, char *mode)
- {
- char *str;
- int res;
- if (!url || !mode)
- return NULL;
- res = Tcl_VarEval (main_interp, "cache::get ", url, NULL);
- if (res == TCL_ERROR) {
- fputs (Tcl_GetVar (main_interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- return NULL;
- }
- str = Tcl_GetStringResult (main_interp);
- return fopen (str, mode);
- }
- char*
- gr_get_fullurl (char *url, char *baseurl)
- {
- int res;
- res = Tcl_VarEval (main_interp, "cache::fullurl ", url, " ", baseurl, NULL);
- if (res == TCL_ERROR) {
- fputs (Tcl_GetVar (main_interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- return NULL;
- }
- return Tcl_GetStringResult (main_interp);
- }
- void
- tcl_PutCache (char *key, ClientData data)
- {
- Tcl_HashEntry *entry;
- int _new;
- entry = Tcl_CreateHashEntry (&cache_hash, key, &_new);
- /* i dont mind entry is newly created or not */
- Tcl_SetHashValue (entry, data);
- }
- ClientData
- tcl_GetCache (char *key)
- {
- Tcl_HashEntry *entry;
- if (!key)
- return NULL;
- entry = Tcl_FindHashEntry (&cache_hash, key);
- if (&entry)
- return NULL;
- return Tcl_GetHashValue (entry);
- }
- static int
- GlCmd (ClientData data,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *CONST objv[])
- {
- Tcl_HashEntry *entry;
- GrFunctionList *funclist;
- int i;
- char *str;
- int res;
- if (objc == 1) {
- OBJ_RESULT (objv[0], ": missing sub-command.");
- return TCL_ERROR;
- }
- for (i=1; i<objc;) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (!str)
- return TCL_ERROR;
- if (str[0] != '-') {
- Tcl_SetObjResult (interp, objv[0]);
- return TCL_ERROR;
- }
- entry = Tcl_FindHashEntry (&gl_func_hash, str+1);
- if (!entry) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp,
- ": unknown sub-command \"", str, "\".", NULL);
- return TCL_ERROR;
- }
- funclist = (GrFunctionList*) Tcl_GetHashValue (entry);
- if ((res = (*funclist->func)(interp, objc-i, objv+i)) <= 0) {
- return TCL_ERROR;
- }
- i += res;
- }
- return TCL_OK;
- }
- static int
- GlutCmd (ClientData data,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *CONST objv[])
- {
- Tcl_HashEntry *entry;
- GrFunctionList *funclist;
- int i;
- char *str;
- int res;
- if (objc == 1) {
- OBJ_RESULT (objv[0], " missing sub-command.");
- return TCL_ERROR;
- }
- for (i=1; i<objc;) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (!str)
- return TCL_ERROR;
- if (str[0] != '-') {
- Tcl_SetObjResult (interp, objv[0]);
- return TCL_ERROR;
- }
- entry = Tcl_FindHashEntry (&glut_func_hash, str+1);
- if (!entry) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp,
- ": unknown sub-command \"", str, "\".", NULL);
- return TCL_ERROR;
- }
- funclist = (GrFunctionList*) Tcl_GetHashValue (entry);
- if ((res = (*funclist->func)(interp, objc-i, objv+i)) <= 0) {
- return TCL_ERROR;
- }
- i += res;
- }
- return TCL_OK;
- }
- static int
- tcl_SetGlutCallback (Tcl_Interp *interp,
- TclGlutCallback *cb,
- Tcl_Obj *CONST script,
- int value)
- {
- int length;
- if (Tcl_ListObjLength (interp, script, &length) == TCL_ERROR)
- return TCL_ERROR;
- if (length > 0) {
- if (cb->obj) {
- Tcl_DecrRefCount (cb->obj);
- }
- cb->interp = interp;
- cb->obj = script;
- Tcl_IncrRefCount (cb->obj);
- cb->value = value;
- } else {
- if (cb->obj) {
- Tcl_DecrRefCount (cb->obj);
- }
- cb->interp = NULL;
- cb->obj = NULL;
- }
- return TCL_OK;
- }
- static int
- tcl_InstallGlutCallback (Tcl_Interp *interp,
- Tcl_HashTable *hash,
- Tcl_Obj *CONST script,
- int key,
- int value)
- {
- int _new;
- Tcl_HashEntry *entry;
- TclGlutCallback *cb;
- int length;
- if (Tcl_ListObjLength (interp, script, &length) == TCL_ERROR)
- return TCL_ERROR;
- if (length == 0) {
- entry = Tcl_FindHashEntry (hash, (ClientData) key);
- if (entry) {
- cb = (TclGlutCallback *) Tcl_GetHashValue (entry);
- if (cb && cb->obj) {
- Tcl_DecrRefCount (cb->obj);
- cb->interp = NULL;
- cb->obj = NULL;
- }
- }
- } else {
- entry = Tcl_CreateHashEntry (hash, (ClientData) key, &_new);
- if (!_new) {
- cb = (TclGlutCallback *) Tcl_GetHashValue (entry);
- if (cb && cb->obj) {
- Tcl_DecrRefCount (cb->obj);
- }
- } else {
- cb = gr_new (TclGlutCallback, 1);
- }
- cb->interp = interp;
- cb->obj = script;
- //cb->obj = Tcl_DuplicateObj (script);
- Tcl_IncrRefCount (cb->obj);
- cb->value = value;
- Tcl_SetHashValue (entry, (ClientData) cb);
- }
- return TCL_OK;
- }
- static TclGlutCallback *
- tcl_GetGlutCallback (Tcl_HashTable *hash, int key)
- {
- Tcl_HashEntry *entry;
- entry = Tcl_FindHashEntry (hash, (ClientData) key);
- if (!entry)
- return NULL;
- return (TclGlutCallback *) Tcl_GetHashValue (entry);
- }
- static int
- tcl_InvokeCallback (TclGlutCallback *cb)
- {
- int res;
- Tcl_Interp *interp = cb->interp;
- Tcl_Obj *obj = cb->obj;
- Tcl_IncrRefCount (obj);
- if ((res = Tcl_EvalObj (interp, obj)) == TCL_ERROR)
- fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- Tcl_DecrRefCount (obj);
- return res;
- }
- void
- tcl_DisplayFunc (void)
- {
- if (!display_cb.interp)
- return;
- tcl_InvokeCallback (&display_cb);
- }
- void
- tcl_ReshapeFunc (int width, int height)
- {
- Tcl_Interp *interp;
- if (!reshape_cb.interp)
- return;
- interp = reshape_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_width, NULL,
- Tcl_NewIntObj(width), 0);
- Tcl_ObjSetVar2 (interp, obj_height, NULL,
- Tcl_NewIntObj(height), 0);
- tcl_InvokeCallback (&reshape_cb);
- }
- void
- tcl_KeyboardFunc (unsigned char key, int x, int y)
- {
- Tcl_Interp *interp;
- if (!keyboard_cb.interp)
- return;
- interp = keyboard_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(keyboard_cb.value), 0);
- tcl_InvokeCallback (&keyboard_cb);
- }
- void
- tcl_KeyboardUpFunc (unsigned char key, int x, int y)
- {
- Tcl_Interp *interp;
- if (!keyboard_up_cb.interp)
- return;
- interp = keyboard_up_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(keyboard_up_cb.value), 0);
- tcl_InvokeCallback (&keyboard_up_cb);
- }
- void
- tcl_SpecialFunc (int key, int x, int y)
- {
- Tcl_Interp *interp;
- if (!special_cb.interp)
- return;
- interp = special_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(special_cb.value), 0);
- tcl_InvokeCallback (&special_cb);
- }
- void
- tcl_SpecialUpFunc (int key, int x, int y)
- {
- Tcl_Interp *interp;
- if (!special_up_cb.interp)
- return;
- interp = special_up_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(special_up_cb.value), 0);
- tcl_InvokeCallback (&special_up_cb);
- }
- void
- tcl_MouseFunc (int button, int state, int x, int y)
- {
- Tcl_Interp *interp;
- if (!mouse_cb.interp)
- return;
- interp = mouse_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_button, NULL, Tcl_NewIntObj(button), 0);
- Tcl_ObjSetVar2 (interp, obj_state, NULL, Tcl_NewIntObj(state), 0);
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(mouse_cb.value), 0);
- tcl_InvokeCallback (&mouse_cb);
- }
- void
- tcl_MotionFunc (int x, int y)
- {
- Tcl_Interp *interp;
- if (!motion_cb.interp)
- return;
- interp = motion_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(motion_cb.value), 0);
- tcl_InvokeCallback (&motion_cb);
- }
- void
- tcl_PassiveMotionFunc (int x, int y)
- {
- Tcl_Interp *interp;
- if (!passive_motion_cb.interp)
- return;
- interp = passive_motion_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(passive_motion_cb.value), 0);
- tcl_InvokeCallback (&passive_motion_cb);
- }
- void
- tcl_EntryFunc (int state)
- {
- Tcl_Interp *interp;
- if (!entry_cb.interp)
- return;
- interp = entry_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_state, NULL, Tcl_NewIntObj(state), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(entry_cb.value), 0);
- tcl_InvokeCallback (&entry_cb);
- }
- void
- tcl_VisibilityFunc (int state)
- {
- Tcl_Interp *interp;
- if (!visibility_cb.interp)
- return;
- interp = visibility_cb.interp;
- Tcl_ObjSetVar2 (interp, obj_state, NULL,
- Tcl_NewIntObj(state), 0);
- Tcl_ObjSetVar2 (interp, obj_value, NULL,
- Tcl_NewIntObj(visibility_cb.value), 0);
- tcl_InvokeCallback (&visibility_cb);
- }
- void
- tcl_TimerFunc (int value)
- {
- TclGlutCallback *cb;
- Tcl_Interp *interp;
- Tcl_Obj *script;
- cb = tcl_GetGlutCallback (&glut_timer_hash, value);
- if (!cb || !cb->obj)
- return;
- interp = cb->interp;
- script = cb->obj;
- cb->obj = NULL;
- Tcl_ObjSetVar2 (interp, obj_value, NULL, Tcl_NewIntObj(value), 0);
- if (Tcl_EvalObj (interp, script) == TCL_ERROR)
- fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- Tcl_DecrRefCount (script);
- }
- void
- tcl_IdleFunc (void)
- {
- Tcl_Interp *interp;
- if (!idle_cb.interp)
- return;
- interp = idle_cb.interp;
- if (Tcl_EvalObj (interp, idle_cb.obj) == TCL_ERROR)
- fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- }
- void
- tcl_MenuStateFunc (int state)
- {
- Tcl_ObjSetVar2 (menu_state_cb.interp, obj_state, NULL,
- Tcl_NewIntObj(state), 0);
- Tcl_ObjSetVar2 (menu_state_cb.interp, obj_value, NULL,
- Tcl_NewIntObj(menu_state_cb.value), 0);
- if (Tcl_EvalObj (menu_state_cb.interp, menu_state_cb.obj) == TCL_ERROR)
- fputs (Tcl_GetVar (menu_state_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
- stderr);
- }
- void
- tcl_TabletMotionFunc (int x, int y)
- {
- Tcl_ObjSetVar2 (tablet_motion_cb.interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (tablet_motion_cb.interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (tablet_motion_cb.interp, obj_value, NULL,
- Tcl_NewIntObj(tablet_motion_cb.value), 0);
- if (Tcl_EvalObj (tablet_motion_cb.interp, tablet_motion_cb.obj)
- == TCL_ERROR)
- fputs (Tcl_GetVar (tablet_motion_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
- stderr);
- }
- void
- tcl_TabletButtonFunc (int button, int state, int x, int y)
- {
- Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_button, NULL,
- Tcl_NewIntObj(button), 0);
- Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_state, NULL,
- Tcl_NewIntObj(state), 0);
- Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_value, NULL,
- Tcl_NewIntObj(tablet_button_cb.value), 0);
- if (Tcl_EvalObj (tablet_button_cb.interp, tablet_button_cb.obj)
- == TCL_ERROR)
- fputs (Tcl_GetVar (tablet_button_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
- stderr);
- }
- void
- tcl_MenuStatusFunc (int status, int x, int y)
- {
- Tcl_ObjSetVar2 (menu_status_cb.interp, obj_status, NULL,
- Tcl_NewIntObj(status), 0);
- Tcl_ObjSetVar2 (menu_status_cb.interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
- Tcl_ObjSetVar2 (menu_status_cb.interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
- Tcl_ObjSetVar2 (menu_status_cb.interp, obj_value, NULL,
- Tcl_NewIntObj(menu_status_cb.value), 0);
- if (Tcl_EvalObj (menu_status_cb.interp, menu_status_cb.obj) == TCL_ERROR)
- fputs (Tcl_GetVar (menu_status_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
- stderr);
- }
- void
- tcl_WindowStatusFunc (int state)
- {
- Tcl_ObjSetVar2 (window_status_cb.interp, obj_state, NULL,
- Tcl_NewIntObj(state), 0);
- Tcl_ObjSetVar2 (window_status_cb.interp, obj_value, NULL,
- Tcl_NewIntObj(window_status_cb.value), 0);
- if (Tcl_EvalObj (window_status_cb.interp, window_status_cb.obj)
- == TCL_ERROR)
- fputs (Tcl_GetVar (window_status_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
- stderr);
- }
- static GrObjectDrawOption
- gr_get_draw_option (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- char *str;
- int i;
- GrObjectDrawOption option = 0, newopt = 0;
- int invert;
- for (i=0; i<objc; i++) {
- invert = 0;
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (str[0] == '!') {
- invert = 1;
- str++;
- }
- if (!strcmp (str, "all")) {
- newopt = GR_OBJECT_ALL;
- } else if (!strcmp (str, "normal")) {
- newopt = GR_OBJECT_NORMAL;
- } else if (!strcmp (str, "color")) {
- newopt = GR_OBJECT_COLOR;
- } else if (!strcmp (str, "texture")) {
- newopt = GR_OBJECT_TEXTURE;
- } else if (!strcmp (str, "mipmap")) {
- newopt = GR_OBJECT_MIPMAP;
- } else if (!strcmp (str, "material")) {
- newopt = GR_OBJECT_MATERIAL;
- } else if (!strcmp (str, "flat")) {
- newopt = GR_OBJECT_FLAT;
- } else if (!strcmp (str, "smooth")) {
- newopt = GR_OBJECT_SMOOTH;
- } else if (!strcmp (str, "mag_nearest")) {
- newopt = GR_OBJECT_MAG_NEAREST;
- } else if (!strcmp (str, "mag_linear")) {
- newopt = GR_OBJECT_MAG_LINEAR;
- } else if (!strcmp (str, "min_nearest")) {
- newopt = GR_OBJECT_MIN_NEAREST;
- } else if (!strcmp (str, "min_linear")) {
- newopt = GR_OBJECT_MIN_LINEAR;
- }
- if (invert) {
- option &= ~newopt;
- } else {
- option |= newopt;
- }
- }
- return option;
- }
- static void
- tcl_GrObjectLoadTexture (Tcl_Interp *interp,
- char *baseurl,
- GrObject *obj,
- int recursive)
- {
- int i;
- char *str;
- char *filename;
- if (obj->texture_name) {
- if (Tcl_VarEval (interp, "cache::fullurl ",
- obj->texture_name, " ", baseurl, NULL) == TCL_ERROR) {
- fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- goto PASS;
- }
- str = Tcl_GetStringResult (interp);
- if (Tcl_VarEval (interp, "cache::get ", str, NULL) == TCL_ERROR) {
- fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
- goto PASS;
- }
- filename = Tcl_GetStringResult (interp);
- if (!(obj->texture = tcl_GetCache (filename))) {
- obj->texture = gr_texture_new_from_file (filename);
- if (!obj->texture) {
- fputs ("can not load texture\n", stderr);
- goto PASS;
- }
- tcl_PutCache (filename, obj->texture);
- }
- gr_INCREF (obj->texture);
- }
- PASS:
- if (recursive) {
- for (i=0; i<obj->num_kids; i++) {
- tcl_GrObjectLoadTexture (interp, baseurl, obj->kids[i], 1);
- }
- }
- }
- void
- tcl_GrSceneLoadTexture (Tcl_Interp *interp, char *baseurl, GrScene *scene)
- {
- int i;
- for (i=0; i<scene->num_objs; i++) {
- tcl_GrObjectLoadTexture (interp, baseurl, scene->objs[i], 1);
- }
- }
- GrScene *tcl_GetGrScene (Tcl_Interp *interp, char *name, char *baseurl)
- {
- GrScene *scene;
- char *fullurl;
- char *str;
- int res;
- FILE *file;
- if (!name)
- return NULL;
- if (baseurl) {
- Tcl_VarEval (interp, "cache::fullurl ", name, " ", baseurl, NULL);
- fullurl = strdup (Tcl_GetStringResult (interp));
- } else {
- fullurl = strdup (name);
- }
- res = Tcl_VarEval (interp, "cache::get ", fullurl, NULL);
- if (res == TCL_ERROR) {
- free (fullurl);
- return NULL;
- }
- str = Tcl_GetStringResult (interp);
- scene = tcl_GetCache (str);
- if (!scene) {
- file = fopen (str, "r");
- if (!file) {
- Tcl_AppendResult (interp, ": couldn't open file.", NULL);
- free (fullurl);
- return NULL;
- }
- scene = gr_scene_new_from_file (file);
- fclose (file);
- if (!scene) {
- Tcl_AppendResult (interp, ": failed to read scene file.", NULL);
- free (fullurl);
- return NULL;
- }
- tcl_PutCache (str, scene);
- tcl_GrSceneLoadTexture (interp, fullurl, scene);
- }
- free (fullurl);
- gr_INCREF (scene);
- return scene;
- }
- static int
- grSceneCmd (ClientData cdata,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *CONST objv[])
- {
- Tcl_HashEntry *entry;
- static int count = 0;
- GrScene *scene;
- char *filename;
- char *url;
- int _new;
- char buf[256];
- FILE *file;
- GrObjectDrawOption option;
- GrObject *object;
- char *str;
- int key;
- double sx, sy, sz;
- if (objc < 2) {
- goto ERROR;
- }
- str = Tcl_GetStringFromObj (objv[1], NULL);
- if (!strcmp (str, "create")) {
- if (objc < 3)
- goto ERROR;
- url = Tcl_GetStringFromObj (objv[2], NULL);
- filename = Tcl_GetStringResult (interp);
- if (Tcl_VarEval (interp, "cache::get ", url, NULL) == TCL_ERROR) {
- return TCL_ERROR;
- }
- filename = Tcl_GetStringResult (interp);
- scene = tcl_GetCache (filename);
- if (!scene) {
- file = fopen (filename, "r");
- if (!file) {
- OBJ_RESULT(objv[0], ": couldn't open file.");
- return TCL_ERROR;
- }
- scene = gr_scene_new_from_file (file);
- fclose (file);
- if (!scene) {
- OBJ_RESULT(objv[0], ": couldn't create scene data.");
- return TCL_ERROR;
- }
- tcl_GrSceneLoadTexture (interp, url, scene);
- }
- gr_INCREF (scene);
- sprintf (buf, "%d", count);
- entry = Tcl_CreateHashEntry (&scene_hash, (ClientData)count++, &_new);
- Tcl_SetHashValue (entry, (ClientData *) scene);
- Tcl_SetResult (interp, buf, TCL_VOLATILE);
- return TCL_OK;
- } else if (!strcmp (str, "destroy")) {
- if (objc < 3)
- goto ERROR;
- Tcl_GetIntFromObj (interp, objv[2], &key);
- entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
- if (!entry) {
- OBJ_RESULT(objv[0], ": scene does not defined.");
- return TCL_ERROR;
- }
- scene = (GrScene *) Tcl_GetHashValue (entry);
- gr_DECREF (scene);
- Tcl_DeleteHashEntry (entry);
- } else if (!strcmp (str, "setup")) {
- if (objc < 3)
- goto ERROR;
- Tcl_GetIntFromObj (interp, objv[2], &key);
- entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
- if (!entry) {
- OBJ_RESULT(objv[0], ": scene does not defined.");
- return TCL_ERROR;
- }
- scene = (GrScene *) Tcl_GetHashValue (entry);
- option = gr_get_draw_option (interp, objc - 3, objv + 3);
- if (option == 0) {
- option = GR_OBJECT_ALL;
- }
- gr_scene_setup_gl (scene, option);
- } else if (!strcmp (str, "release")) {
- if (objc < 3)
- goto ERROR;
- Tcl_GetIntFromObj (interp, objv[2], &key);
- entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
- if (!entry) {
- OBJ_RESULT(objv[0], ": scene does not defined.");
- return TCL_ERROR;
- }
- scene = (GrScene *) Tcl_GetHashValue (entry);
- gr_scene_release_gl (scene);
- } else if (!strcmp (str, "draw")) {
- if (objc < 3)
- goto ERROR;
- Tcl_GetIntFromObj (interp, objv[2], &key);
- entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
- if (!entry) {
- OBJ_RESULT(objv[0], ": scene does not defined.");
- return TCL_ERROR;
- }
- scene = (GrScene *) Tcl_GetHashValue (entry);
- str = Tcl_GetStringFromObj (objv[3], NULL);
- object = NULL;
- if (!strcmp(str, "-obj")) {
- str = Tcl_GetStringFromObj (objv[4], NULL);
- object = gr_scene_find_object (scene, str, NULL);
- option = gr_get_draw_option (interp, objc - 5, objv + 5);
- } else {
- option = gr_get_draw_option (interp, objc - 3, objv + 3);
- }
- if (option == 0) {
- option = GR_OBJECT_ALL;
- }
- glPushMatrix ();
- gr_scene_draw (scene, object, option, 1);
- glPopMatrix ();
- } else if (!strcmp (str, "scale")) {
- if (objc < 6)
- goto ERROR;
- Tcl_GetIntFromObj (interp, objv[2], &key);
- entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
- if (!entry) {
- OBJ_RESULT(objv[0], ": scene does not defined.");
- return TCL_ERROR;
- }
- scene = (GrScene *) Tcl_GetHashValue (entry);
- Tcl_GetDoubleFromObj (interp, objv[3], &sx);
- Tcl_GetDoubleFromObj (interp, objv[4], &sy);
- Tcl_GetDoubleFromObj (interp, objv[5], &sz);
- gr_scene_scale (scene, sx, sy, sz);
- } else {
- goto ERROR;
- }
- return TCL_OK;
- ERROR:
- OBJ_RESULT (objv[0],
- ": wrong args. should be create <url>, destroy <scene>, setup <scene>, "
- "release <scene>, draw <scene>, or scale <scene> <sx> <sy> <sz>.\n");
- return TCL_ERROR;
- }
- #include <X11/Xlib.h>
- extern Display *__glutDisplay;
- extern Window __glutRoot;
- extern struct GLUTwindow *__glutCurrentWindow;
- #if 0
- static Tcl_Obj*
- ObjFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
- {
- Tcl_Obj *item = NULL;
- Tcl_ListObjIndex (interp, list, index, &item);
- return item;
- }
- static int
- IntFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
- {
- Tcl_Obj *item;
- int val = 0;
- if (Tcl_ListObjIndex (interp, list, index, &item) == TCL_ERROR)
- return 0.0;
- Tcl_GetIntFromObj (interp, item, &val);
- return val;
- }
- #endif
- static double
- DoubleFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
- {
- Tcl_Obj *item;
- double val = 0.0;
- if (Tcl_ListObjIndex (interp, list, index, &item) == TCL_ERROR)
- return 0.0;
- Tcl_GetDoubleFromObj (interp, item, &val);
- return val;
- }
- #if 0
- static char *
- StringFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
- {
- Tcl_Obj *item;
- if (Tcl_ListObjIndex (interp, list, index, &item) == TCL_ERROR)
- return NULL;
- return Tcl_GetStringFromObj (item, NULL);
- }
- static int
- CheckNumArg (Tcl_Interp *interp, Tcl_Obj *arg, int num, char *message)
- {
- int argc;
- if (Tcl_ListObjLength (interp, arg, &argc) == TCL_ERROR)
- return TCL_ERROR;
- if (argc != num) {
- Tcl_AppendResult (interp, " ",
- StringFromList (interp, arg, 0),
- ": wrong # args. ", message, NULL);
- return TCL_ERROR;
- }
- return TCL_OK;
- }
- #endif
- GLenum
- GetGLEnum (Tcl_Obj *CONST obj)
- {
- char *str;
- Tcl_HashEntry *entry;
- str = Tcl_GetStringFromObj (obj, NULL);
- if (!str)
- return GL_NONE;
- entry = Tcl_FindHashEntry (&gl_enum_hash, str);
- if (!entry)
- return GL_NONE;
- return (GLenum) Tcl_GetHashValue (entry);
- }
- void *
- GetGlutEnum (Tcl_Obj *CONST obj)
- {
- char *str;
- Tcl_HashEntry *entry;
- str = Tcl_GetStringFromObj (obj, NULL);
- if (!str)
- return GL_NONE;
- entry = Tcl_FindHashEntry (&glut_enum_hash, str);
- if (!entry)
- return GL_NONE;
- return (void *) Tcl_GetHashValue (entry);
- }
- static int
- gl_subcmd_vertex (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double v[4];
- if (objc < 3) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &v[0]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &v[1]), ERROR);
- if (objc < 4 || Tcl_GetDoubleFromObj (interp, objv[3], &v[2]) == TCL_ERROR) {
- glVertex2dv (v);
- return 3;
- }
- if (objc < 5 || Tcl_GetDoubleFromObj (interp, objv[4], &v[3]) == TCL_ERROR) {
- glVertex3dv (v);
- return 4;
- } else {
- glVertex4dv (v);
- return 5;
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be x y [z [w]]");
- return 0;
- }
- static int
- gl_subcmd_normal (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double v[3];
- if (objc < 4) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &v[0]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &v[1]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &v[2]), ERROR);
- glNormal3dv (v);
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be nx ny nz.");
- return 0;
- }
- static int
- gl_subcmd_color (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double c[4];
- if (objc < 4) goto ERROR;
- 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) {
- glColor3dv (c);
- return 4;
- } else {
- glColor4dv (c);
- return 5;
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. r g b [a]");
- return 0;
- }
- static int
- gl_subcmd_enable (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum attr;
- int i;
- char *str;
- for (i=1; i < objc; i++) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (str && str[0] == '-') {
- return i;
- }
- attr = GetGLEnum (objv[i]);
- if (attr == GL_NONE) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": unknown attribute \"", str, "\".", NULL);
- return 0;
- }
- GL_CHECK(glEnable (attr));
- }
- return i;
- }
- static int
- gl_subcmd_deletelists (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int list;
- int range;
- if (objc < 3) {
- OBJ_RESULT (objv[0], ": wrong # args. should be <name> <range>");
- return 0;
- }
- TCL_CHECK (Tcl_GetIntFromObj (interp, objv[1], &list), ERROR);
- TCL_CHECK (Tcl_GetIntFromObj (interp, objv[2], &range), ERROR);
- GL_CHECK(glDeleteLists (list, range));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong args. should be integer value.");
- return 0;
- }
- static int
- gl_subcmd_deletetextures (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int i;
- int val;
- for (i=1; i<objc; i++) {
- if (Tcl_GetIntFromObj (interp, objv[i], &val) == TCL_ERROR)
- break;
- GL_CHECK(glDeleteTextures (1, &val));
- }
- if (i==1) {
- OBJ_RESULT (objv[0], ": wrong # args. should be tex [tex ...]");
- return 0;
- }
- return i;
- }
- static int
- gl_subcmd_disable (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum attr;
- int i;
- char *str;
- for (i=1; i < objc; i++) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (str && str[0] == '-') {
- return i;
- }
- attr = GetGLEnum (objv[i]);
- if (attr == GL_NONE) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": unknown attribute \"", str, "\".", NULL);
- return 0;
- }
- GL_CHECK(glDisable (attr));
- }
- return i;
- }
- static int
- gl_subcmd_begin (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- glBegin (mode);
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": couldn't get valid primitive type.");
- return 0;
- }
- static int
- gl_subcmd_end (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glEnd ());
- return 1;
- }
- static int
- gl_subcmd_translate (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double x, y, z;
- if (objc < 4) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &x), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &y), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &z), ERROR);
- GL_CHECK(glTranslated (x, y, z));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be x y z.");
- return 0;
- }
- static int
- gl_subcmd_rotate (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double x, y, z, angle;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &angle), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &x), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &y), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &z), ERROR);
- GL_CHECK(glRotated (angle, x, y, z));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be angle x y z.");
- return 0;
- }
- static int
- gl_subcmd_scale (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double x, y, z;
- if (objc < 4) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &x), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &y), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &z), ERROR);
- GL_CHECK(glScaled (x, y, z));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be sx sy sz.");
- return 0;
- }
- static int
- gl_subcmd_loadidentity (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glLoadIdentity ());
- return 1;
- }
- static int
- gl_subcmd_viewport (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double left, right, bottom, top;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &left), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &right), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &bottom), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &top), ERROR);
- GL_CHECK(glViewport (left, right, bottom, top));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be left right bottom top.");
- return 0;
- }
- static int
- gl_subcmd_frustum (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double left, right, bottom, top, near, far;
- if (objc < 7) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &left), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &right), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &bottom), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &top), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &near), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &far), ERROR);
- GL_CHECK(glFrustum (left, right, bottom, top, near, far));
- return 7;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be "
- "left right bottom top near far.");
- return 0;
- }
- static int
- gl_subcmd_ortho (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double left, right, bottom, top, near, far;
- if (objc < 7) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &left), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &right), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &bottom), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &top), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &near), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &far), ERROR);
- GL_CHECK(glOrtho (left, right, bottom, top, near, far));
- return 7;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be "
- "left right bottom top near far.");
- return 0;
- }
- static int
- gl_subcmd_matrixmode (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glMatrixMode (mode));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": couldn't get valid mode.");
- return 0;
- }
- static int
- gl_subcmd_clearcolor (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double r, g, b, a;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
- GL_CHECK(glClearColor (r, g, b, a));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be r g b a.");
- return 0;
- }
- static int
- gl_subcmd_clear (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLbitfield mask = 0, res;
- int i;
- char *str;
- if (objc < 2) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. mode [mode ...].", NULL);
- return 0;
- }
- for (i=1; i<objc; i++) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (str && str[0] == '-')
- break;
- ENUM_CHECK((res = GetGLEnum (objv[i])), ERROR);
- mask |= (GLbitfield) res;
- }
- GL_CHECK(glClear (mask));
- return i;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": unkown mode \"", str, "\".", NULL);
- return 0;
- }
- static int
- gl_subcmd_genlists (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int num = 1;
- GLuint name;
- Tcl_Obj *val;
- if (objc == 1) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. varName ?num?.", NULL);
- return 0;
- }
- if (objc > 2 && Tcl_GetIntFromObj (interp, objv[2], &num) == TCL_ERROR) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong args. num must be integer.", NULL);
- return 0;
- }
- GL_CHECK(name = glGenLists (num));
- val = Tcl_NewIntObj (name);
- Tcl_ObjSetVar2 (interp, objv[1], NULL, val, 0);
- return (objc > 2)? 3:2;
- }
- static int
- gl_subcmd_newlist (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLuint name;
- GLenum mode;
- if (objc < 3) goto ERROR;
- TCL_CHECK (Tcl_GetIntFromObj (interp, objv[1], &name), ERROR);
- TCL_CHECK((mode = GetGLEnum (objv[2])), ERROR);
- GL_CHECK(glNewList (name, mode));
- return 3;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong args. should be id mode.", NULL);
- return 0;
- }
- static int
- gl_subcmd_endlist (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glEndList ());
- return 1;
- }
- static int
- gl_subcmd_calllist (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLuint name;
- int i;
- if (objc < 2) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. id [id ...].", NULL);
- return 0;
- }
- for (i=1; i<objc; i++) {
- if (Tcl_GetIntFromObj (interp, objv[i], &name) == TCL_ERROR)
- break;
- GL_CHECK(glCallList (name));
- }
- return i;
- }
- static int
- gl_subcmd_pushmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glPushMatrix ());
- return 1;
- }
- static int
- gl_subcmd_popmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glPopMatrix ());
- return 1;
- }
- static int
- gl_subcmd_accum (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double r, g, b, a;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
- GL_CHECK(glClearColor (r, g, b, a));
- return 5;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be r g b a.", NULL);
- return 0;
- }
- static int
- gl_subcmd_alphafunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum func;
- double ref;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((func = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &ref), ERROR);
- GL_CHECK(glAlphaFunc (func, ref));
- return 3;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be func ref.", NULL);
- return 0;
- }
- static int
- gl_subcmd_bindtexture (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum target;
- int texture;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((target = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &texture), ERROR);
- GL_CHECK(glBindTexture (target, texture));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should be target texture.");
- return 0;
- }
- static int
- gl_subcmd_blendfunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum sfactor;
- GLenum dfactor;
- ENUM_CHECK((sfactor = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((dfactor = GetGLEnum (objv[2])), ERROR);
- GL_CHECK(glBlendFunc (sfactor, dfactor));
- return 3;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be sfactor dfactor.", NULL);
- return 0;
- }
- static int
- gl_subcmd_clearaccum (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double r, g, b, a;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
- GL_CHECK(glClearAccum (r, g, b, a));
- return 5;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be r g b a.", NULL);
- return 0;
- }
- static int
- gl_subcmd_cleardepth (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double depth;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &depth), ERROR);
- GL_CHECK(glClearDepth (depth));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be depth.", NULL);
- return 0;
- }
- static int
- gl_subcmd_clearstencil (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int stencil;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &stencil), ERROR);
- GL_CHECK(glClearStencil (stencil));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be stencil.", NULL);
- return 0;
- }
- static int
- gl_subcmd_copypixels (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int x, y;
- int width, height;
- GLenum type;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &x), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &y), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &width), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &height), ERROR);
- ENUM_CHECK((type = GetGLEnum (objv[5])), ERROR);
- GL_CHECK(glCopyPixels (x, y, width, height, type));
- return 6;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be x y w h type.", NULL);
- return 0;
- }
- static int
- gl_subcmd_clipplane (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum plane;
- GLdouble eq[4];
- if (objc < 6) goto ERROR;
- ENUM_CHECK((plane = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &eq[0]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &eq[1]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &eq[2]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &eq[3]), ERROR);
- GL_CHECK(glClipPlane (plane, eq));
- return 6;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be plane a b c d.", NULL);
- return 0;
- }
- static int
- gl_subcmd_colormask (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double r, g, b, a;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
- GL_CHECK(glColorMask (r, g, b, a));
- return 5;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be r g b a.", NULL);
- return 0;
- }
- static int
- gl_subcmd_colormaterial (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum face, mode;
- ENUM_CHECK((face = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((mode = GetGLEnum (objv[2])), ERROR);
- GL_CHECK(glColorMaterial (face, mode));
- return 3;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be face mode.", NULL);
- return 0;
- }
- static int
- gl_subcmd_cullface (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glCullFace (mode));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be mode.", NULL);
- return 0;
- }
- static int
- gl_subcmd_depthfunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum func;
- ENUM_CHECK((func = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glDepthFunc (func));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be func.", NULL);
- return 0;
- }
- static int
- gl_subcmd_depthmask (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int flag;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &flag), ERROR);
- GL_CHECK(glDepthMask (flag));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be flag.", NULL);
- return 0;
- }
- static int
- gl_subcmd_drawbuffer (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int mode;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glDrawBuffer (mode));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be mode.", NULL);
- return 0;
- }
- #if 0
- static int
- gl_subcmd_drawpixels (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- char *name;
- GLenum format;
- Tk_PhotoHandle handle;
- Tk_PhotoImageBlock block;
- if (objc < 3)
- goto ERROR;
- ENUM_CHECK ((format = GetGLEnum (objv[1])), ERROR);
- name = Tcl_GetStringFromObj (objv[2], NULL);
- if (!name)
- goto ERROR;
- handle = Tk_FindPhoto (interp, name);
- if (!handle) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": photo not found.", NULL);
- return 0;
- }
- if (Tk_PhotoGetImage (handle, &block) != 1) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": couldn't get image of photo.", NULL);
- return 0;
- }
- switch (format) {
- case GL_RGB:
- if (block.pixelSize != 3) goto TYPE_MISMATCH;
- break;
- case GL_RGBA:
- if (block.pixelSize != 4) goto TYPE_MISMATCH;
- break;
- case GL_RED:
- case GL_GREEN:
- case GL_BLUE:
- case GL_ALPHA:
- case GL_LUMINANCE:
- case GL_LUMINANCE_ALPHA:
- case GL_STENCIL_INDEX:
- case GL_DEPTH_COMPONENT:
- if (block.pixelSize != 1) goto TYPE_MISMATCH;
- break;
- default:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong format.", NULL);
- return 0;
- }
- GL_CHECK(glPixelStorei (GL_UNPACK_ALIGNMENT, 1));
- GL_CHECK(glDrawPixels (block.width, block.height,
- format, GL_UNSIGNED_BYTE, block.pixelPtr));
- return 3;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should be x y w h type.", NULL);
- return 0;
- TYPE_MISMATCH:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": type mismatch.", NULL);
- return 0;
- }
- #endif
- static int
- gl_subcmd_edgeflag (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int flag;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &flag), ERROR);
- GL_CHECK(glEdgeFlag (flag));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should flag.", NULL);
- return 0;
- }
- static int
- gl_subcmd_evalcoord1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double u;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &u), ERROR);
- GL_CHECK(glEvalCoord1d (u));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should u.", NULL);
- return 0;
- }
- static int
- gl_subcmd_evalcoord2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double u, v;
- if (objc < 3) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &u), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &v), ERROR);
- GL_CHECK(glEvalCoord2d (u, v));
- return 3;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should u v.", NULL);
- return 0;
- }
- static int
- gl_subcmd_evalmesh1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- int i1, i2;
- if (objc < 4) goto ERROR;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &i1), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &i2), ERROR);
- GL_CHECK(glEvalMesh1 (mode, i1, i2));
- return 4;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should mode i1 i2.", NULL);
- return 0;
- }
- static int
- gl_subcmd_evalmesh2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- int i1, i2;
- int j1, j2;
- if (objc < 6) goto ERROR;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &i1), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &i2), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &j1), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[5], &j2), ERROR);
- GL_CHECK(glEvalMesh2 (mode, i1, i2, j1, j2));
- return 6;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should mode i1 i2 j1 j2.", NULL);
- return 0;
- }
- static int
- gl_subcmd_flush (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glFlush ());
- return 1;
- }
- static int
- gl_subcmd_fog (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum pname;
- double fparam;
- GLfloat c[4];
- int iparam;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
- switch (pname) {
- case GL_FOG_MODE:
- ENUM_CHECK((iparam = GetGLEnum (objv[2])), ERROR);
- glFogi (pname, iparam);
- return 3;
- case GL_FOG_DENSITY:
- case GL_FOG_START:
- case GL_FOG_END:
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &fparam), ERROR);
- glFogf (pname, fparam);
- return 3;
- case GL_FOG_COLOR:
- if (objc < 6) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &fparam), ERROR);
- c[0] = fparam;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &fparam), ERROR);
- c[1] = fparam;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &fparam), ERROR);
- c[2] = fparam;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &fparam), ERROR);
- c[3] = fparam;
- GL_CHECK(glFogfv (pname, c));
- return 6;
- default:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong parameter name.", NULL);
- return 0;
- }
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should mode i1 i2 j1 j2.", NULL);
- return 0;
- }
- static int
- gl_subcmd_frontface (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- if (objc < 2) goto ERROR;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glFrontFace (mode));
- return 2;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should flag.", NULL);
- return 0;
- }
- static int
- gl_subcmd_gentextures (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int num = 1;
- GLuint *names;
- Tcl_Obj *val;
- int i;
- int nargs = 1;
- if (objc < 2) goto ERROR;
- if (objc >= 3 && Tcl_GetIntFromObj (interp, objv[2], &num) != TCL_ERROR) {
- nargs = 2;
- }
- names = gr_new (GLuint, num);
- GL_CHECK(glGenTextures (num, names));
- if (num == 1) {
- val = Tcl_NewIntObj (names[0]);
- Tcl_ObjSetVar2 (interp, objv[1], NULL, val, 0);
- } else {
- val = Tcl_NewListObj (0, NULL);
- for (i=0; i<num; i++) {
- Tcl_ListObjAppendElement (interp, val, Tcl_NewIntObj (names[i]));
- }
- Tcl_ObjSetVar2 (interp, objv[1], NULL, val, 0);
- }
- return nargs + 1;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": wrong # args. should flag.", NULL);
- return 0;
- }
- static int
- gl_subcmd_hint (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum target;
- GLenum mode;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((target = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((mode = GetGLEnum (objv[2])), ERROR);
- GL_CHECK(glHint (target, mode));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should flag.");
- return 0;
- }
- static int
- gl_subcmd_initnames (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glInitNames ());
- return 1;
- }
- static int
- gl_subcmd_light (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLfloat f[4];
- double d;
- GLenum light;
- GLenum pname;
- int i, num;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((light = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((pname = GetGLEnum (objv[2])), ERROR);
- switch (pname) {
- case GL_AMBIENT:
- case GL_DIFFUSE:
- case GL_SPECULAR:
- case GL_POSITION:
- num = 4;
- break;
- case GL_SPOT_DIRECTION:
- num = 3;
- break;
- case GL_SPOT_EXPONENT:
- case GL_SPOT_CUTOFF:
- case GL_CONSTANT_ATTENUATION:
- case GL_LINEAR_ATTENUATION:
- case GL_QUADRATIC_ATTENUATION:
- num = 1;
- break;
- default:
- goto ERROR;
- }
- if (objc < 3 + num) goto ERROR;
- for (i=0; i<num; i++) {
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3+i], &d), ERROR);
- f[i] = d;
- }
- GL_CHECK(glLightfv (light, pname, f));
- return num + 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
- return 0;
- }
- static int
- gl_subcmd_lightmodel (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLfloat f[4];
- double d;
- int i;
- GLenum pname;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
- switch (pname) {
- case GL_LIGHT_MODEL_AMBIENT:
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &d), ERROR);
- f[0] = d;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &d), ERROR);
- f[1] = d;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], &d), ERROR);
- f[2] = d;
- GL_CHECK(glLightModelfv (pname, f));
- return 6;
- case GL_LIGHT_MODEL_LOCAL_VIEWER:
- case GL_LIGHT_MODEL_TWO_SIDE:
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &i), ERROR);
- GL_CHECK(glLightModeli (pname, i));
- return 3;
- default:
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
- return 0;
- }
- static int
- gl_subcmd_loadmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLdouble m[16];
- int i, j;
- if (objc < 17) goto ERROR;
- for (i=0; i<4; i++) {
- for (j=0; j<4; j++) {
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[i*4+j+1], &m[i+j*4]), ERROR);
- }
- }
- GL_CHECK(glLoadMatrixd (m));
- return 17;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. m[0][0] m[0][1] ...");
- return 0;
- }
- static int
- gl_subcmd_lookat (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLdouble eyex, eyey, eyez;
- GLdouble centerx, centery, centerz;
- GLdouble upx, upy, upz;
- if (objc < 10) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &eyex), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &eyey), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &eyez), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], ¢erx), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[5], ¢ery), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[6], ¢erz), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[7], &upx), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[8], &upy), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[9], &upz), ERROR);
- GL_CHECK(gluLookAt (eyex, eyey, eyez,
- centerx, centery, centerz,
- upx, upy, upz));
- return 10;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. eye[xyz] center[xyz] up[xyz].");
- return 0;
- }
- static int
- gl_subcmd_linestipple (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int factor;
- int pattern;
- if (objc < 3) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &factor), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &pattern), ERROR);
- GL_CHECK(glLineStipple (factor, pattern));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should factor pattern.");
- return 0;
- }
- static int
- gl_subcmd_linewidth (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double width;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &width), ERROR);
- GL_CHECK(glLineWidth (width));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should width.");
- return 0;
- }
- static int
- gl_subcmd_loadname (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int name;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &name), ERROR);
- GL_CHECK(glLoadName (name));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should name.");
- return 0;
- }
- static int
- gl_subcmd_map1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum target;
- double u1, u2;
- int stride, order;
- double *p;
- int i, total;
- if (objc < 6) goto ERROR;
- ENUM_CHECK ((target = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &stride), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[5], &order), ERROR);
- total = stride * order;
- p = gr_new (GLdouble, total);
- if (!p)
- goto ERROR;
- for (i=0; i<total; i++) {
- p[i] = DoubleFromList (interp, objv[6], i);
- }
- GL_CHECK(glMap1d (target, u1, u2, stride, order, p));
- free (p);
- return 7;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should target u1 u2 stride order "
- "{point ... }");
- return 0;
- }
- static int
- gl_subcmd_map2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum target;
- double u1, u2;
- double v1, v2;
- int ustride, uorder;
- int vstride, vorder;
- double *p;
- int i, total;
- if (objc < 10) goto ERROR;
- ENUM_CHECK ((target = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &ustride), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[5], &uorder), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &v1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[7], &v2), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[8], &vstride), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[9], &vorder), ERROR);
- total = ustride * uorder * vorder;
- if (objc < 10 + total) goto ERROR;
- p = gr_new (GLdouble, total);
- if (!p)
- goto ERROR;
- for (i=0; i<total; i++) {
- p[i] = DoubleFromList (interp, objv[8], i);
- }
- GL_CHECK(glMap2d (target,
- u1, u2, ustride, uorder,
- v1, v2, vstride, vorder, p));
- free (p);
- return 11;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should target u1 u2 "
- "ustride uorder v1 v2 vstride vorder {point ... }");
- return 0;
- }
- static int
- gl_subcmd_mapgrid1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int n;
- double u1, u2;
- if (objc < 4) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &n), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
- GL_CHECK(glMapGrid1d (n, u1, u2));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. n u1 u2.");
- return 0;
- }
- static int
- gl_subcmd_mapgrid2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int nu, nv;
- double u1, u2;
- double v1, v2;
- if (objc < 7) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &nu), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &nv), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &v1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &v2), ERROR);
- GL_CHECK(glMapGrid2d (nu, u1, u2, nv, v1, v2));
- return 7;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. nu u1 u2 nv v1 v2.");
- return 0;
- }
- static int
- gl_subcmd_material (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum face, pname;
- int i, num;
- GLfloat p[4];
- double d;
- if (objc < 4) goto ERROR;
- ENUM_CHECK ((face = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK ((pname = GetGLEnum (objv[2])), ERROR);
- switch (pname) {
- case GL_AMBIENT:
- case GL_DIFFUSE:
- case GL_AMBIENT_AND_DIFFUSE:
- case GL_SPECULAR:
- case GL_EMISSION:
- if (objc < 7) goto ERROR;
- num = 4;
- break;
- case GL_SHININESS:
- num = 1;
- break;
- default:
- goto ERROR;
- }
- for (i=0; i<num; i++) {
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3+i], &d), ERROR);
- p[i] = d;
- }
- GL_CHECK(glMaterialfv (face, pname, p));
- return 3 + num;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should face pname param ...");
- return 0;
- }
- static int
- gl_subcmd_multmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLdouble m[16];
- int i, j;
- if (objc < 17) goto ERROR;
- for (i=0; i<4; i++) {
- for (j=0; j<4; j++) {
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[i*4+j+1], &m[i+j*4]), ERROR);
- }
- }
- GL_CHECK(glMultMatrixd (m));
- return 17;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. m[0][0] m[0][1] ...");
- return 0;
- }
- static int
- gl_subcmd_perspective (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double fov, aspect, near, far;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &fov), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &aspect), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &near), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], &far), ERROR);
- GL_CHECK(gluPerspective (fov, aspect, near, far));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should fovy aspect near far.");
- return 0;
- }
- static int
- gl_subcmd_pickmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double x, y, width, height;
- int viewport[4];
- if (objc < 9) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &x), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &y), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &width), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], &height), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[5], &viewport[0]), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[6], &viewport[1]), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[7], &viewport[2]), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[8], &viewport[3]), ERROR);
- GL_CHECK(gluPickMatrix (x, y, width, height, viewport));
- return 9;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should x y w h v0 v1 v2 v3.");
- return 0;
- }
- static int
- gl_subcmd_pixeltransfer (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum pname;
- double param;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], ¶m), ERROR);
- GL_CHECK(glPixelTransferf (pname, param));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should pname param.");
- return 0;
- }
- static int
- gl_subcmd_pixelzoom (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double xf, yf;
- if (objc < 3) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &xf), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &yf), ERROR);
- GL_CHECK(glPixelZoom (xf, yf));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should xfactor yfactor.");
- return 0;
- }
- static int
- gl_subcmd_polygonmode (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum face, mode;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((face = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((mode = GetGLEnum (objv[2])), ERROR);
- GL_CHECK(glPolygonMode (face, mode));
- return 3;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should face mode.");
- return 0;
- }
- static int
- gl_subcmd_pointsize (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double size;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &size), ERROR);
- GL_CHECK(glPointSize (size));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should size.");
- return 0;
- }
- static int
- gl_subcmd_popattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glPopAttrib ());
- return 1;
- }
- static int
- gl_subcmd_popclientattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glPopClientAttrib ());
- return 1;
- }
- static int
- gl_subcmd_popname (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GL_CHECK(glPopName ());
- return 1;
- }
- static int
- gl_subcmd_pushattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLbitfield mask = 0, res;
- int i;
- char *str;
- if (objc < 2) {
- OBJ_RESULT (objv[0], ": wrong # args. mask [mask ...].");
- return 0;
- }
- for (i=1; i<objc; i++) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (str && str[0] == '-')
- break;
- ENUM_CHECK((res = GetGLEnum (objv[i])), ERROR);
- mask |= (GLbitfield) res;
- }
- GL_CHECK(glPushAttrib (mask));
- return i;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": unkown attrib \"", str, "\".", NULL);
- return 0;
- }
- static int
- gl_subcmd_pushclientattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLbitfield mask = 0, res;
- int i;
- char *str;
- if (objc < 2) {
- OBJ_RESULT (objv[0], ": wrong # args. mask [mask ...].");
- return 0;
- }
- for (i=1; i<objc; i++) {
- str = Tcl_GetStringFromObj (objv[i], NULL);
- if (str && str[0] == '-')
- break;
- ENUM_CHECK((res = GetGLEnum (objv[i])), ERROR);
- mask |= (GLbitfield) res;
- }
- GL_CHECK(glPushClientAttrib (mask));
- return i;
- ERROR:
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": unkown attrib \"", str, "\".", NULL);
- return 0;
- }
- static int
- gl_subcmd_pushname (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int name;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &name), ERROR);
- GL_CHECK(glPushName (name));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should name.");
- return 0;
- }
- static int
- gl_subcmd_rasterpos (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double c[4];
- if (objc < 3) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &c[0]), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &c[1]), ERROR);
- if (objc < 4 || Tcl_GetDoubleFromObj (interp, objv[3], &c[2]) == TCL_ERROR) {
- GL_CHECK(glRasterPos2dv (c));
- return 3;
- } else
- if (objc < 5 || Tcl_GetDoubleFromObj (interp, objv[4], &c[3]) == TCL_ERROR) {
- GL_CHECK(glRasterPos3dv (c));
- return 4;
- } else {
- GL_CHECK(glRasterPos4dv (c));
- return 4;
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. x y [z [w]].");
- return 0;
- }
- #if 0
- static int
- gl_subcmd_readpixels (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- char *name;
- int x, y;
- Tk_PhotoHandle handle;
- Tk_PhotoImageBlock block;
- if (objc < 4) goto ERROR;
- name = Tcl_GetStringFromObj (objv[1], NULL);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &x), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &y), ERROR);
- handle = Tk_FindPhoto (interp, name);
- if (!handle) {
- OBJ_RESULT (objv[0], ": photo not defined.", name, NULL);
- return 0;
- }
- if (Tk_PhotoGetImage (handle, &block) != 1) {
- OBJ_RESULT (objv[0], ": couldn't get photo image.");
- return 0;
- }
- if (block.pixelSize != 3 && block.pixelSize != 4) {
- OBJ_RESULT (objv[0], ": image has invalid pixel size.");
- return 0;
- }
- switch (block.pitch - block.width * block.pixelSize) {
- case 0:
- GL_CHECK(glPixelStorei (GL_PACK_ALIGNMENT, 1));
- break;
- case 1:
- GL_CHECK(glPixelStorei (GL_PACK_ALIGNMENT, 2));
- break;
- case 2:
- case 3:
- GL_CHECK(glPixelStorei (GL_PACK_ALIGNMENT, 4));
- break;
- default:
- OBJ_RESULT (objv[0], ": unknown alignment.");
- return 0;
- }
- GL_CHECK(glReadPixels (x, y, block.width, block.height,
- block.pixelSize == 3? GL_RGB : GL_RGBA,
- GL_UNSIGNED_BYTE, block.pixelPtr));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. image x y.");
- return 0;
- }
- #endif
- static int
- gl_subcmd_readbuffer (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- if (objc < 2) goto ERROR;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glReadBuffer (mode));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should mode.");
- return 0;
- }
- static int
- gl_subcmd_rect (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double x1, y1, x2, y2;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &x1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &y1), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &x2), ERROR);
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &y2), ERROR);
- GL_CHECK(glRectd (x1, y1, x2, y2));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should x1 y1 x2 y2.");
- return 0;
- }
- static int
- gl_subcmd_scissor (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int x, y, w, h;
- if (objc < 5) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &x), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &y), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &w), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &h), ERROR);
- GL_CHECK(glScissor (x, y, w, h));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should x y w h.");
- return 0;
- }
- static int
- gl_subcmd_shademodel (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum mode;
- if (objc < 2) goto ERROR;
- ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
- GL_CHECK(glShadeModel (mode));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should mode.");
- return 0;
- }
- static int
- gl_subcmd_stencilfunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum func;
- int ref, mask;
- if (objc < 4) goto ERROR;
- ENUM_CHECK((func = GetGLEnum (objv[1])), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &ref), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[3], &mask), ERROR);
- GL_CHECK(glStencilFunc(func, ref, mask));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should func ref mask.");
- return 0;
- }
- static int
- gl_subcmd_stencilmask (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int mask;
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj(interp, objv[1], &mask), ERROR);
- GL_CHECK(glStencilMask(mask));
- return 2;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should mask.");
- return 0;
- }
- static int
- gl_subcmd_stencilop (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum fail, zfail, zpass;
- if (objc < 4) goto ERROR;
- ENUM_CHECK((fail = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((zfail = GetGLEnum (objv[2])), ERROR);
- ENUM_CHECK((zpass = GetGLEnum (objv[3])), ERROR);
- GL_CHECK(glStencilOp(fail, zfail, zpass));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should fail zfail zpass.");
- return 0;
- }
- static int
- gl_subcmd_texcoord (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- double v[4];
- if (objc < 2) goto ERROR;
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &v[0]), ERROR);
- if (objc < 3 || Tcl_GetDoubleFromObj(interp, objv[2], &v[1]) == TCL_ERROR) {
- GL_CHECK(glTexCoord1dv (v));
- return 2;
- }
- if (objc < 4 || Tcl_GetDoubleFromObj(interp, objv[3], &v[2]) == TCL_ERROR) {
- GL_CHECK(glTexCoord2dv (v));
- return 3;
- }
- if (objc < 5 || Tcl_GetDoubleFromObj(interp, objv[4], &v[3]) == TCL_ERROR) {
- GL_CHECK(glTexCoord3dv (v));
- return 4;
- }
- GL_CHECK(glTexCoord4dv (v));
- return 5;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. should s [t [r [q]]].");
- return 0;
- }
- static int
- gl_subcmd_texenv (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum pname;
- GLenum eparam;
- float param[4];
- double d;
- int i;
- if (objc < 3) goto ERROR;
- ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
- switch (pname) {
- case GL_TEXTURE_ENV_MODE:
- ENUM_CHECK((eparam = GetGLEnum (objv[2])), ERROR);
- GL_CHECK(glTexEnvi (GL_TEXTURE_ENV, pname, eparam));
- return 3;
- case GL_TEXTURE_ENV_COLOR:
- if (objc < 6) goto ERROR;
- for (i=0; i<4; i++) {
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2+i], &d), ERROR);
- param[i] = d;
- }
- GL_CHECK(glTexEnvfv (GL_TEXTURE_ENV, pname, param));
- return 6;
- default:
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
- return 0;
- }
- static int
- gl_subcmd_texgen (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum coord;
- GLenum pname;
- GLenum eparam;
- float param[4];
- double d;
- int i;
- if (objc < 4) goto ERROR;
- ENUM_CHECK((coord = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((pname = GetGLEnum (objv[2])), ERROR);
- switch (pname) {
- case GL_TEXTURE_GEN_MODE:
- ENUM_CHECK((eparam = GetGLEnum (objv[3])), ERROR);
- GL_CHECK(glTexGeni (coord, pname, eparam));
- return 4;
- default:
- if (objc < 7) goto ERROR;
- for (i=0; i<4; i++) {
- TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3+i], &d), ERROR);
- param[i] = d;
- }
- GL_CHECK(glTexGenfv (coord, pname, param));
- return 7;
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
- return 0;
- }
- #if 0
- static int
- gl_subcmd_teximage1d (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int level;
- int border;
- Tk_PhotoHandle handle;
- Tk_PhotoImageBlock block;
- char *name;
- int i, n;
- if (objc < 4) goto ERROR;
- name = Tcl_GetStringFromObj (objv[1], NULL);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &level), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &border), ERROR);
- handle = Tk_FindPhoto (interp, name);
- if (!handle) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": photo not defined \"", name, "\".", NULL);
- return 0;
- }
- if (Tk_PhotoGetImage (handle, &block) != 1) {
- OBJ_RESULT (objv[0], ": couldn't get photo image.");
- return 0;
- }
- if (block.pixelSize != 3 && block.pixelSize != 4) {
- OBJ_RESULT (objv[0], ": image has invalid pixel size.");
- return 0;
- }
- n = block.width - border;
- for (i=0; i<16; i++) {
- if (n == (1<<i))
- break;
- }
- if (i == 16) {
- OBJ_RESULT (objv[0], ": image width must be a power of 2.");
- return 0;
- }
- GL_CHECK(glPixelStorei (GL_UNPACK_ALIGNMENT, 1));
- GL_CHECK(glTexImage1D (GL_TEXTURE_1D, level, block.pixelSize,
- block.width, border,
- block.pixelSize == 3 ? GL_RGB : GL_RGBA,
- GL_UNSIGNED_BYTE, block.pixelPtr));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. image level border.");
- return 0;
- }
- static int
- gl_subcmd_teximage2d (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- int level;
- int border;
- Tk_PhotoHandle handle;
- Tk_PhotoImageBlock block;
- char *name;
- int i, n;
- if (objc < 4) goto ERROR;
- name = Tcl_GetStringFromObj (objv[1], NULL);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &level), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &border), ERROR);
- handle = Tk_FindPhoto (interp, name);
- if (!handle) {
- Tcl_SetObjResult (interp, objv[0]);
- Tcl_AppendResult (interp, ": photo not defined \"", name, "\".", NULL);
- return 0;
- }
- if (Tk_PhotoGetImage (handle, &block) != 1) {
- OBJ_RESULT (objv[0], ": couldn't get photo image.");
- return 0;
- }
- if (block.pixelSize != 3 && block.pixelSize != 4) {
- OBJ_RESULT (objv[0], ": image has invalid pixel size.");
- return 0;
- }
- n = block.width - border;
- for (i=0; i<16; i++) {
- if (n == (1<<i))
- break;
- }
- if (i == 16) {
- OBJ_RESULT (objv[0], ": image width must be a power of 2.");
- return 0;
- }
- n = block.height - border;
- for (i=0; i<16; i++) {
- if (n == (1<<i))
- break;
- }
- if (i == 16) {
- OBJ_RESULT (objv[0], ": image height must be a power of 2.");
- return 0;
- }
- GL_CHECK(glPixelStorei (GL_UNPACK_ALIGNMENT, 1));
- GL_CHECK(glTexImage2D (GL_TEXTURE_2D, level, block.pixelSize,
- block.width, block.height, border,
- block.pixelSize == 3 ? GL_RGB : GL_RGBA,
- GL_UNSIGNED_BYTE, block.pixelPtr));
- return 4;
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. image level border.");
- return 0;
- }
- #endif
- static int
- gl_subcmd_texparameter (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
- {
- GLenum target;
- GLenum pname;
- GLenum eparam;
- float param[4];
- double d;
- int i;
- if (objc < 4) goto ERROR;
- ENUM_CHECK((target = GetGLEnum (objv[1])), ERROR);
- ENUM_CHECK((pname = GetGLEnum (objv[2])), ERROR);
- switch (pname) {
- case GL_TEXTURE_WRAP_S:
- case GL_TEXTURE_WRAP_T:
- case GL_TEXTURE_MAG_FILTER:
- case GL_TEXTURE_MIN_FILTER:
- ENUM_CHECK((eparam = GetGLEnum (objv[3])), ERROR);
- GL_CHECK(glTexParameteri (target, pname, eparam));
- return 4;
- case GL_TEXTURE_BORDER_COLOR:
- if (objc < 7) goto ERROR;
- for (i=0; i<4; i++) {
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3+i], &d), ERROR);
- param[i] = d;
- }
- GL_CHECK(glTexParameterfv (target, pname, param));
- return 7;
- case GL_TEXTURE_PRIORITY:
- TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &d), ERROR);
- param[0] = d;
- GL_CHECK(glTexParameterf (target, pname, param[0]));
- return 4;
- default:
- }
- ERROR:
- OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
- return 0;
- }
- static GrFunctionList glfunclist[] = {
- {"accum", gl_subcmd_accum},
- {"alphafunc", gl_subcmd_alphafunc},
- {"begin", gl_subcmd_begin},
- {"bindtexture", gl_subcmd_bindtexture},
- {"blendfunc", gl_subcmd_blendfunc},
- {"calllist", gl_subcmd_calllist},
- {"clear", gl_subcmd_clear},
- {"clearaccum", gl_subcmd_clearaccum},
- {"clearcolor", gl_subcmd_clearcolor},
- {"cleardepth", gl_subcmd_cleardepth},
- {"clearstencil", gl_subcmd_clearstencil},
- {"copypixels", gl_subcmd_copypixels},
- {"clipplane", gl_subcmd_clipplane},
- {"color", gl_subcmd_color},
- {"colormask", gl_subcmd_colormask},
- {"colormaterial", gl_subcmd_colormaterial},
- {"cullface", gl_subcmd_cullface},
- {"deletelists", gl_subcmd_deletelists},
- {"deletetextures", gl_subcmd_deletetextures},
- {"depthfunc", gl_subcmd_depthfunc},
- {"depthmask", gl_subcmd_depthmask},
- {"disable", gl_subcmd_disable},
- {"drawbuffer", gl_subcmd_drawbuffer},
- #if 0
- {"drawpixels", gl_subcmd_drawpixels},
- #endif
- {"edgeflag", gl_subcmd_edgeflag},
- {"enable", gl_subcmd_enable},
- {"end", gl_subcmd_end},
- {"endlist", gl_subcmd_endlist},
- {"evalcoord1", gl_subcmd_evalcoord1},
- {"evalcoord2", gl_subcmd_evalcoord2},
- {"evalmesh1", gl_subcmd_evalmesh1},
- {"evalmesh2", gl_subcmd_evalmesh2},
- {"flush", gl_subcmd_flush},
- {"fog", gl_subcmd_fog},
- {"frontface", gl_subcmd_frontface},
- {"frustum", gl_subcmd_frustum},
- {"genlists", gl_subcmd_genlists},
- {"gentextures", gl_subcmd_gentextures},
- {"hint", gl_subcmd_hint},
- {"initnames", gl_subcmd_initnames},
- {"light", gl_subcmd_light},
- {"lightmodel", gl_subcmd_lightmodel},
- {"loadmatrix", gl_subcmd_loadmatrix},
- {"lookat", gl_subcmd_lookat},
- {"linestipple", gl_subcmd_linestipple},
- {"linewidth", gl_subcmd_linewidth},
- {"loadidentity", gl_subcmd_loadidentity},
- {"loadname", gl_subcmd_loadname},
- {"map1", gl_subcmd_map1},
- {"map2", gl_subcmd_map2},
- {"mapgrid1", gl_subcmd_mapgrid1},
- {"mapgrid2", gl_subcmd_mapgrid2},
- {"material", gl_subcmd_material},
- {"matrixmode", gl_subcmd_matrixmode},
- {"multmatrix", gl_subcmd_multmatrix},
- {"newlist", gl_subcmd_newlist},
- {"normal", gl_subcmd_normal},
- {"ortho", gl_subcmd_ortho},
- {"perspective", gl_subcmd_perspective},
- {"pickmatrix", gl_subcmd_pickmatrix},
- {"pixeltransfer", gl_subcmd_pixeltransfer},
- {"pixelzoom", gl_subcmd_pixelzoom},
- {"polygonmode", gl_subcmd_polygonmode},
- {"pointsize", gl_subcmd_pointsize},
- {"popattrib", gl_subcmd_popattrib},
- {"popclientattrib", gl_subcmd_popclientattrib},
- {"popmatrix", gl_subcmd_popmatrix},
- {"popname", gl_subcmd_popname},
- {"pushattrib", gl_subcmd_pushattrib},
- {"pushclientattrib", gl_subcmd_pushclientattrib},
- {"pushmatrix", gl_subcmd_pushmatrix},
- {"pushname", gl_subcmd_pushname},
- {"rasterpos", gl_subcmd_rasterpos},
- #if 0
- {"readpixels", gl_subcmd_readpixels},
- #endif
- {"readbuffer", gl_subcmd_readbuffer},
- {"rect", gl_subcmd_rect},
- {"rotate", gl_subcmd_rotate},
- {"scale", gl_subcmd_scale},
- {"scissor", gl_subcmd_scissor},
- {"shademodel", gl_subcmd_shademodel},
- {"stencilfunc", gl_subcmd_stencilfunc},
- {"stencilmask", gl_subcmd_stencilmask},
- {"stencilop", gl_subcmd_stencilop},
- {"texcoord", gl_subcmd_texcoord},
- {"texenv", gl_subcmd_texenv},
- {"texgen", gl_subcmd_texgen},
- #if 0
- {"teximage1d", gl_subcmd_teximage1d},
- {"teximage2d", gl_subcmd_teximage2d},
- #endif
- {"texparameter", gl_subcmd_texparameter},
- {"translate", gl_subcmd_translate},
- {"vertex", gl_subcmd_vertex},
- {"viewport", gl_subcmd_viewport},
- {NULL},
- };
- static int glut_subcmd_display_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &display_cb, objv[1], value);
- return 2;
- }
- static int glut_subcmd_reshape_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &reshape_cb, objv[1], value);
- return 2;
- }
- static int glut_subcmd_keyboard_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &keyboard_cb, objv[1], value);
- return 2;
- }
- static int glut_subcmd_keyboard_up_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &keyboard_up_cb, objv[1], value);
- glutKeyboardUpFunc (tcl_KeyboardUpFunc);
- return 2;
- }
- static int glut_subcmd_mouse_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &mouse_cb, objv[1], value);
- return 2;
- }
- static int glut_subcmd_motion_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &motion_cb, objv[1], value);
- glutMotionFunc (tcl_MotionFunc);
- return 2;
- }
- static int glut_subcmd_passive_motion_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &passive_motion_cb, objv[1], value);
- return 2;
- }
- static int glut_subcmd_entry_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &entry_cb, objv[1], value);
- glutEntryFunc (tcl_EntryFunc);
- return 2;
- }
- static int glut_subcmd_visibility_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &visibility_cb, objv[1], value);
- glutVisibilityFunc (tcl_VisibilityFunc);
- return 2;
- }
- static int glut_subcmd_idle_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- idle_cb.interp = interp;
- idle_cb.obj = objv[1];
- Tcl_IncrRefCount (objv[1]);
- glutIdleFunc (tcl_IdleFunc);
- return 2;
- }
- static int glut_subcmd_timer_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- long millis;
- int value;
- Tcl_GetLongFromObj (interp, objv[1], &millis);
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_InstallGlutCallback (interp, &glut_timer_hash, objv[3], value, value);
- glutTimerFunc (millis, tcl_TimerFunc, value);
- return 4;
- }
- static int glut_subcmd_menu_state_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &menu_state_cb, objv[1], value);
- glutMenuStateFunc (tcl_MenuStateFunc);
- return 2;
- }
- static int glut_subcmd_special_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &special_cb, objv[1], value);
- return 2;
- }
- static int glut_subcmd_special_up_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &special_up_cb, objv[1], value);
- glutSpecialUpFunc (tcl_SpecialUpFunc);
- return 2;
- }
- static int glut_subcmd_tablet_motion_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &tablet_motion_cb, objv[1], value);
- glutTabletMotionFunc (tcl_TabletMotionFunc);
- return 2;
- }
- static int glut_subcmd_tablet_button_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &tablet_button_cb, objv[1], value);
- glutTabletButtonFunc (tcl_TabletButtonFunc);
- return 2;
- }
- static int glut_subcmd_menu_status_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &menu_status_cb, objv[1], value);
- glutMenuStatusFunc (tcl_MenuStatusFunc);
- return 2;
- }
- static int glut_subcmd_window_status_func (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- Tcl_GetIntFromObj (interp, objv[2], &value);
- tcl_SetGlutCallback (interp, &window_status_cb, objv[1], value);
- glutWindowStatusFunc (tcl_WindowStatusFunc);
- return 2;
- }
- static int glut_subcmd_window_position (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int x, y;
- if (objc < 3)
- goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &x), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &y), ERROR);
- glutInitWindowPosition (x, y);
- return 3;
- ERROR:
- Tcl_AppendResult (interp, ": wrong # args. should be <x> <y>.", NULL);
- return 0;
- }
- static int glut_subcmd_window_size (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int w, h;
- if (objc < 3)
- goto ERROR;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &w), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &h), ERROR);
- glutInitWindowSize (w, h);
- return 3;
- ERROR:
- Tcl_AppendResult (interp, ": wrong # args. should be <w> <h>.", NULL);
- return 0;
- }
- static int glut_subcmd_create_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_create_subwindow (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_destroy_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_post_redisplay (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- glutPostRedisplay ();
- return 1;
- }
- static int glut_subcmd_swap_buffers (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- glutSwapBuffers ();
- return 1;
- }
- static int glut_subcmd_set_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_set_window_title (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_set_icon_title (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_position_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_reshape_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int width;
- int height;
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &width), ERROR);
- TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &height), ERROR);
- glutReshapeWindow (width, height);
- return 3;
- ERROR:
- OBJ_RESULT(objv[0], ": wrong # args. should be width height");
- return 0;
- }
- static int glut_subcmd_pop_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_push_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_iconify_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_show_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_hide_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_get_window (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_full_screen (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_set_cursor (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_warp_pointer (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_create_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_destroy_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_get_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_set_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_add_menu_entry (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_add_sub_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_change_to_menu_entry (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_change_to_sub_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_remove_menu_item (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_attach_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_detach_menu (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_get (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_device_get (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_get_modifiers (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_bitmap_character (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int i, len;
- void *font = GetGlutEnum (objv[1]);
- char *string = Tcl_GetStringFromObj (objv[2], &len);
- for (i=0; i < len; i++) {
- glutBitmapCharacter (font, string[i]);
- }
- return 3;
- }
- static int glut_subcmd_bitmap_width (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_stroke_character (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int i;
- void *font = GetGlutEnum (objv[1]);
- char *string = Tcl_GetStringFromObj (objv[2], NULL);
- for (i=0; string[i] != '\0'; i++) {
- glutStrokeCharacter (font, string[i]);
- }
- return 3;
- }
- static int glut_subcmd_stroke_width (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_bitmap_length (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_stroke_length (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_sphere (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_sphere (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_cone (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_cone (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_cube (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_cube (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_torus (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_torus (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_dodecahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_dodecahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_teapot (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_teapot (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_octahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_octahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_tetrahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_tetrahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_wire_icosahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_solid_icosahedron (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_video_resize_get (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_setup_video_resizing (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_stop_video_resizing (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_video_resize (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_video_pan (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_report_errors (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- return 1;
- }
- static int glut_subcmd_ignore_keyrepeat (Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST objv[])
- {
- int value;
- if (objc < 2 ||
- Tcl_GetBooleanFromObj (interp, objv[1], &value) == TCL_ERROR) {
- Tcl_AppendResult (interp, ": -ignorekeyrepeat <bool>.", NULL);
- return 0;
- }
- glutIgnoreKeyRepeat (value);
- return 2;
- }
- static GrFunctionList glutfunclist[] = {
- {"displayfunc", glut_subcmd_display_func},
- {"reshapefunc", glut_subcmd_reshape_func},
- {"keyboardfunc", glut_subcmd_keyboard_func},
- {"keyboardupfunc", glut_subcmd_keyboard_up_func},
- {"mousefunc", glut_subcmd_mouse_func},
- {"motionfunc", glut_subcmd_motion_func},
- {"passivemotionfunc", glut_subcmd_passive_motion_func},
- {"entryfunc", glut_subcmd_entry_func},
- {"visibilityfunc", glut_subcmd_visibility_func},
- {"idlefunc", glut_subcmd_idle_func},
- {"timerfunc", glut_subcmd_timer_func},
- {"menustatefunc", glut_subcmd_menu_state_func},
- {"specialfunc", glut_subcmd_special_func},
- {"specialupfunc", glut_subcmd_special_up_func},
- {"tabletmotionfunc", glut_subcmd_tablet_motion_func},
- {"tabletbuttonfunc", glut_subcmd_tablet_button_func},
- {"menustatusfunc", glut_subcmd_menu_status_func},
- {"windowstatusfunc", glut_subcmd_window_status_func},
- {"initwindowposition", glut_subcmd_window_position},
- {"initwindowsize", glut_subcmd_window_size},
- {"createwindow", glut_subcmd_create_window},
- {"createsubwindow", glut_subcmd_create_subwindow},
- {"destroywindow", glut_subcmd_destroy_window},
- {"postredisplay", glut_subcmd_post_redisplay},
- {"swapbuffers", glut_subcmd_swap_buffers},
- {"getwindow", glut_subcmd_get_window},
- {"setwindow", glut_subcmd_set_window},
- {"setwindow_title", glut_subcmd_set_window_title},
- {"seticontitle", glut_subcmd_set_icon_title},
- {"positionwindow", glut_subcmd_position_window},
- {"reshapewindow", glut_subcmd_reshape_window},
- {"popwindow", glut_subcmd_pop_window},
- {"pushwindow", glut_subcmd_push_window},
- {"iconifywindow", glut_subcmd_iconify_window},
- {"showwindow", glut_subcmd_show_window},
- {"hidewindow", glut_subcmd_hide_window},
- {"fullscreen", glut_subcmd_full_screen},
- {"setcursor", glut_subcmd_set_cursor},
- {"warppointer", glut_subcmd_warp_pointer},
- {"createmenu", glut_subcmd_create_menu},
- {"destroymenu", glut_subcmd_destroy_menu},
- {"getmenu", glut_subcmd_get_menu},
- {"setmenu", glut_subcmd_set_menu},
- {"addmenuentry", glut_subcmd_add_menu_entry},
- {"addsubmenu", glut_subcmd_add_sub_menu},
- {"changetomenuentry", glut_subcmd_change_to_menu_entry},
- {"changetosubmenu", glut_subcmd_change_to_sub_menu},
- {"removemenuitem", glut_subcmd_remove_menu_item},
- {"attachmenu", glut_subcmd_attach_menu},
- {"detachmenu", glut_subcmd_detach_menu},
- {"get", glut_subcmd_get},
- {"deviceget", glut_subcmd_device_get},
- {"getmodifiers", glut_subcmd_get_modifiers},
- {"bitmapcharacter", glut_subcmd_bitmap_character},
- {"bitmapwidth", glut_subcmd_bitmap_width},
- {"strokecharacter", glut_subcmd_stroke_character},
- {"strokewidth", glut_subcmd_stroke_width},
- {"bitmaplength", glut_subcmd_bitmap_length},
- {"strokelength", glut_subcmd_stroke_length},
- {"wiresphere", glut_subcmd_wire_sphere},
- {"solidsphere", glut_subcmd_solid_sphere},
- {"wirecone", glut_subcmd_wire_cone},
- {"solidcone", glut_subcmd_solid_cone},
- {"wirecube", glut_subcmd_wire_cube},
- {"solidcube", glut_subcmd_solid_cube},
- {"wiretorus", glut_subcmd_wire_torus},
- {"solidtorus", glut_subcmd_solid_torus},
- {"wiredodecahedron", glut_subcmd_wire_dodecahedron},
- {"soliddodecahedron", glut_subcmd_solid_dodecahedron},
- {"wireteapot", glut_subcmd_wire_teapot},
- {"solidteapot", glut_subcmd_solid_teapot},
- {"wireoctahedron", glut_subcmd_wire_octahedron},
- {"solidoctahedron", glut_subcmd_solid_octahedron},
- {"wiretetrahedron", glut_subcmd_wire_tetrahedron},
- {"solidtetrahedron", glut_subcmd_solid_tetrahedron},
- {"wireicosahedron", glut_subcmd_wire_icosahedron},
- {"solidicosahedron", glut_subcmd_solid_icosahedron},
- {"videoresizeget", glut_subcmd_video_resize_get},
- {"setupvideoresizing", glut_subcmd_setup_video_resizing},
- {"stopvideoresizing", glut_subcmd_stop_video_resizing},
- {"videoresize", glut_subcmd_video_resize},
- {"videopan", glut_subcmd_video_pan},
- {"reporterrors", glut_subcmd_report_errors},
- {"ignorekeyrepeat", glut_subcmd_ignore_keyrepeat},
- {NULL, NULL},
- };
- static int
- real_init (Tcl_Interp *interp)
- {
- static int do_init = 1;
- int i;
- int _new;
- Tcl_HashEntry *entry;
- if (do_init) {
- do_init = 0;
- Tcl_InitHashTable (&gl_enum_hash, TCL_STRING_KEYS);
- Tcl_InitHashTable (&gl_func_hash, TCL_STRING_KEYS);
- Tcl_InitHashTable (&glut_enum_hash, TCL_STRING_KEYS);
- Tcl_InitHashTable (&glut_func_hash, TCL_STRING_KEYS);
- Tcl_InitHashTable (&scene_hash, TCL_ONE_WORD_KEYS);
- Tcl_InitHashTable (&glut_timer_hash, TCL_ONE_WORD_KEYS);
- Tcl_InitHashTable (&cache_hash, TCL_STRING_KEYS);
- obj_x = Tcl_NewStringObj ("X", 1);
- obj_y = Tcl_NewStringObj ("Y", 1);
- obj_width = Tcl_NewStringObj ("WIDTH", 5);
- obj_height = Tcl_NewStringObj ("HEIGHT", 6);
- obj_state = Tcl_NewStringObj ("STATE", 5);
- obj_status = Tcl_NewStringObj ("STATUS", 6);
- obj_key = Tcl_NewStringObj ("KEY", 3);
- obj_button = Tcl_NewStringObj ("BUTTON", 6);
- obj_value = Tcl_NewStringObj ("VALUE", 5);
- for (i=0; glwordlist[i].name != NULL; i++) {
- entry = Tcl_CreateHashEntry (&gl_enum_hash, glwordlist[i].name, &_new);
- Tcl_SetHashValue (entry, (ClientData) glwordlist[i].val);
- }
- for (i=0; glfunclist[i].name != NULL; i++) {
- entry = Tcl_CreateHashEntry (&gl_func_hash,
- glfunclist[i].name, &_new);
- Tcl_SetHashValue (entry, (ClientData) &glfunclist[i]);
- }
- for (i=0; glutwordlist[i].name != NULL; i++) {
- entry = Tcl_CreateHashEntry (&glut_enum_hash,
- glutwordlist[i].name, &_new);
- Tcl_SetHashValue (entry, (ClientData) glutwordlist[i].val);
- }
- for (i=0; glutfunclist[i].name != NULL; i++) {
- entry = Tcl_CreateHashEntry (&glut_func_hash,
- glutfunclist[i].name, &_new);
- Tcl_SetHashValue (entry, (ClientData) &glutfunclist[i]);
- }
- }
- Tcl_CreateObjCommand (interp, "gl", GlCmd, NULL, NULL);
- Tcl_CreateObjCommand (interp, "glut", GlutCmd, NULL, NULL);
- Tcl_CreateObjCommand (interp, "gr::scene", grSceneCmd, NULL, NULL);
- return TCL_OK;
- }
- int
- Glbind_Init (Tcl_Interp *interp)
- {
- main_interp = interp;
- return real_init (interp);
- }
- int
- Glbind_SafeInit (Tcl_Interp *interp)
- {
- return real_init (interp);
- }