1 /*
2 * GRacer
3 *
4 * Copyright (C) 1999 Takashi Matsuda <matsu@users.sourceforge.net>
5 *
6 * This program is free software; you can redistribute it and/or
7 * modify it under the terms of the GNU General Public License as
8 * published by the Free Software Foundation; either version 2 of the
9 * License, or (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this program; if not, write to the Free Software
18 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
19 * USA
20 */
21
22 #include <unistd.h>
23 #define GL_GLEXT_LEGACY
24 #include <GL/gl.h>
25 #include <GL/glut.h>
26 #include <string.h>
27 #include <stdlib.h>
28 #include <ctype.h>
29 #include "tcldefs.h"
30 #include <common/gr_memory.h>
31 #include <common/gr_scene.h>
32 #include <common/gr_debug.h>
33 #include "glbind.h"
34
35 #include "glhash.h"
36 #include "gluthash.h"
37
38 #define ENUM_CHECK(cmd,label) if ((cmd) == GL_NONE) {goto label;}
39
40 Tcl_Interp *main_interp;
41
42 static Tcl_HashTable gl_enum_hash;
43 static Tcl_HashTable gl_func_hash;
44
45 static Tcl_HashTable glut_enum_hash;
46 static Tcl_HashTable glut_func_hash;
47
48 static Tcl_HashTable cache_hash;
49
50 static Tcl_HashTable scene_hash;
51
52 static Tcl_HashTable glut_timer_hash;
53
54 static TclGlutCallback display_cb;
55 static TclGlutCallback reshape_cb;
56 static TclGlutCallback keyboard_cb;
57 static TclGlutCallback keyboard_up_cb;
58 static TclGlutCallback special_cb;
59 static TclGlutCallback special_up_cb;
60 static TclGlutCallback mouse_cb;
61 static TclGlutCallback motion_cb;
62 static TclGlutCallback passive_motion_cb;
63 static TclGlutCallback entry_cb;
64 static TclGlutCallback visibility_cb;
65 static TclGlutCallback menu_state_cb;
66 static TclGlutCallback tablet_motion_cb;
67 static TclGlutCallback tablet_button_cb;
68 static TclGlutCallback menu_status_cb;
69 static TclGlutCallback window_status_cb;
70 static TclGlutCallback idle_cb;
71
72 Tcl_Obj *obj_x;
73 Tcl_Obj *obj_y;
74 Tcl_Obj *obj_width;
75 Tcl_Obj *obj_height;
76 Tcl_Obj *obj_state;
77 Tcl_Obj *obj_status;
78 Tcl_Obj *obj_key;
79 Tcl_Obj *obj_button;
80 Tcl_Obj *obj_value;
81
82 typedef int (*GrSubCmdFunc)(Tcl_Interp *, int objc, Tcl_Obj *CONST objv[]);
83
84 typedef struct {
85 char *name;
86 GrSubCmdFunc func;
87 int value;
88 } GrFunctionList;
89
90 FILE*
gr_open_file(char * url,char * mode)91 gr_open_file (char *url, char *mode)
92 {
93 char *str;
94 int res;
95
96 if (!url || !mode)
97 return NULL;
98
99 res = Tcl_VarEval (main_interp, "cache::get ", url, NULL);
100 if (res == TCL_ERROR) {
101 fputs (Tcl_GetVar (main_interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
102 return NULL;
103 }
104
105 str = Tcl_GetStringResult (main_interp);
106
107 return fopen (str, mode);
108 }
109
110 char*
gr_get_fullurl(char * url,char * baseurl)111 gr_get_fullurl (char *url, char *baseurl)
112 {
113 int res;
114
115 res = Tcl_VarEval (main_interp, "cache::fullurl ", url, " ", baseurl, NULL);
116 if (res == TCL_ERROR) {
117 fputs (Tcl_GetVar (main_interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
118 return NULL;
119 }
120 return Tcl_GetStringResult (main_interp);
121 }
122
123 void
tcl_PutCache(char * key,ClientData data)124 tcl_PutCache (char *key, ClientData data)
125 {
126 Tcl_HashEntry *entry;
127 int _new;
128
129 entry = Tcl_CreateHashEntry (&cache_hash, key, &_new);
130
131 /* i dont mind entry is newly created or not */
132 Tcl_SetHashValue (entry, data);
133 }
134
135 ClientData
tcl_GetCache(char * key)136 tcl_GetCache (char *key)
137 {
138 Tcl_HashEntry *entry;
139
140 if (!key)
141 return NULL;
142
143 entry = Tcl_FindHashEntry (&cache_hash, key);
144 if (&entry)
145 return NULL;
146
147 return Tcl_GetHashValue (entry);
148 }
149
150 static int
GlCmd(ClientData data,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])151 GlCmd (ClientData data,
152 Tcl_Interp *interp,
153 int objc,
154 Tcl_Obj *CONST objv[])
155 {
156 Tcl_HashEntry *entry;
157 GrFunctionList *funclist;
158 int i;
159 char *str;
160 int res;
161
162 if (objc == 1) {
163 OBJ_RESULT (objv[0], ": missing sub-command.");
164 return TCL_ERROR;
165 }
166
167 for (i=1; i<objc;) {
168 str = Tcl_GetStringFromObj (objv[i], NULL);
169 if (!str)
170 return TCL_ERROR;
171
172 if (str[0] != '-') {
173 Tcl_SetObjResult (interp, objv[0]);
174 return TCL_ERROR;
175 }
176 entry = Tcl_FindHashEntry (&gl_func_hash, str+1);
177 if (!entry) {
178 Tcl_SetObjResult (interp, objv[0]);
179 Tcl_AppendResult (interp,
180 ": unknown sub-command \"", str, "\".", NULL);
181 return TCL_ERROR;
182 }
183 funclist = (GrFunctionList*) Tcl_GetHashValue (entry);
184 if ((res = (*funclist->func)(interp, objc-i, objv+i)) <= 0) {
185 return TCL_ERROR;
186 }
187 i += res;
188 }
189
190 return TCL_OK;
191 }
192
193 static int
GlutCmd(ClientData data,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])194 GlutCmd (ClientData data,
195 Tcl_Interp *interp,
196 int objc,
197 Tcl_Obj *CONST objv[])
198 {
199 Tcl_HashEntry *entry;
200 GrFunctionList *funclist;
201 int i;
202 char *str;
203 int res;
204
205 if (objc == 1) {
206 OBJ_RESULT (objv[0], " missing sub-command.");
207 return TCL_ERROR;
208 }
209
210 for (i=1; i<objc;) {
211 str = Tcl_GetStringFromObj (objv[i], NULL);
212 if (!str)
213 return TCL_ERROR;
214
215 if (str[0] != '-') {
216 Tcl_SetObjResult (interp, objv[0]);
217 return TCL_ERROR;
218 }
219 entry = Tcl_FindHashEntry (&glut_func_hash, str+1);
220 if (!entry) {
221 Tcl_SetObjResult (interp, objv[0]);
222 Tcl_AppendResult (interp,
223 ": unknown sub-command \"", str, "\".", NULL);
224 return TCL_ERROR;
225 }
226 funclist = (GrFunctionList*) Tcl_GetHashValue (entry);
227 if ((res = (*funclist->func)(interp, objc-i, objv+i)) <= 0) {
228 return TCL_ERROR;
229 }
230 i += res;
231 }
232
233 return TCL_OK;
234 }
235
236 static int
tcl_SetGlutCallback(Tcl_Interp * interp,TclGlutCallback * cb,Tcl_Obj * CONST script,int value)237 tcl_SetGlutCallback (Tcl_Interp *interp,
238 TclGlutCallback *cb,
239 Tcl_Obj *CONST script,
240 int value)
241 {
242 int length;
243
244 if (Tcl_ListObjLength (interp, script, &length) == TCL_ERROR)
245 return TCL_ERROR;
246
247 if (length > 0) {
248 if (cb->obj) {
249 Tcl_DecrRefCount (cb->obj);
250 }
251 cb->interp = interp;
252 cb->obj = script;
253 Tcl_IncrRefCount (cb->obj);
254 cb->value = value;
255 } else {
256 if (cb->obj) {
257 Tcl_DecrRefCount (cb->obj);
258 }
259 cb->interp = NULL;
260 cb->obj = NULL;
261 }
262
263 return TCL_OK;
264 }
265
266 static int
tcl_InstallGlutCallback(Tcl_Interp * interp,Tcl_HashTable * hash,Tcl_Obj * CONST script,int key,int value)267 tcl_InstallGlutCallback (Tcl_Interp *interp,
268 Tcl_HashTable *hash,
269 Tcl_Obj *CONST script,
270 int key,
271 int value)
272 {
273 int _new;
274 Tcl_HashEntry *entry;
275 TclGlutCallback *cb;
276 int length;
277
278 if (Tcl_ListObjLength (interp, script, &length) == TCL_ERROR)
279 return TCL_ERROR;
280
281 if (length == 0) {
282 entry = Tcl_FindHashEntry (hash, (ClientData) key);
283 if (entry) {
284 cb = (TclGlutCallback *) Tcl_GetHashValue (entry);
285 if (cb && cb->obj) {
286 Tcl_DecrRefCount (cb->obj);
287 cb->interp = NULL;
288 cb->obj = NULL;
289 }
290 }
291 } else {
292 entry = Tcl_CreateHashEntry (hash, (ClientData) key, &_new);
293 if (!_new) {
294 cb = (TclGlutCallback *) Tcl_GetHashValue (entry);
295 if (cb && cb->obj) {
296 Tcl_DecrRefCount (cb->obj);
297 }
298 } else {
299 cb = gr_new (TclGlutCallback, 1);
300 }
301 cb->interp = interp;
302 cb->obj = script;
303 //cb->obj = Tcl_DuplicateObj (script);
304 Tcl_IncrRefCount (cb->obj);
305 cb->value = value;
306 Tcl_SetHashValue (entry, (ClientData) cb);
307 }
308
309 return TCL_OK;
310 }
311
312 static TclGlutCallback *
tcl_GetGlutCallback(Tcl_HashTable * hash,int key)313 tcl_GetGlutCallback (Tcl_HashTable *hash, int key)
314 {
315 Tcl_HashEntry *entry;
316
317 entry = Tcl_FindHashEntry (hash, (ClientData) key);
318 if (!entry)
319 return NULL;
320
321 return (TclGlutCallback *) Tcl_GetHashValue (entry);
322 }
323
324 static int
tcl_InvokeCallback(TclGlutCallback * cb)325 tcl_InvokeCallback (TclGlutCallback *cb)
326 {
327 int res;
328 Tcl_Interp *interp = cb->interp;
329 Tcl_Obj *obj = cb->obj;
330
331 Tcl_IncrRefCount (obj);
332 if ((res = Tcl_EvalObj (interp, obj)) == TCL_ERROR)
333 fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
334 Tcl_DecrRefCount (obj);
335
336 return res;
337 }
338
339 void
tcl_DisplayFunc(void)340 tcl_DisplayFunc (void)
341 {
342 if (!display_cb.interp)
343 return;
344
345 tcl_InvokeCallback (&display_cb);
346 }
347
348 void
tcl_ReshapeFunc(int width,int height)349 tcl_ReshapeFunc (int width, int height)
350 {
351 Tcl_Interp *interp;
352
353 if (!reshape_cb.interp)
354 return;
355 interp = reshape_cb.interp;
356
357 Tcl_ObjSetVar2 (interp, obj_width, NULL,
358 Tcl_NewIntObj(width), 0);
359 Tcl_ObjSetVar2 (interp, obj_height, NULL,
360 Tcl_NewIntObj(height), 0);
361
362 tcl_InvokeCallback (&reshape_cb);
363 }
364
365 void
tcl_KeyboardFunc(unsigned char key,int x,int y)366 tcl_KeyboardFunc (unsigned char key, int x, int y)
367 {
368 Tcl_Interp *interp;
369
370 if (!keyboard_cb.interp)
371 return;
372 interp = keyboard_cb.interp;
373
374 Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
375 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
376 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
377 Tcl_ObjSetVar2 (interp, obj_value, NULL,
378 Tcl_NewIntObj(keyboard_cb.value), 0);
379
380 tcl_InvokeCallback (&keyboard_cb);
381 }
382
383 void
tcl_KeyboardUpFunc(unsigned char key,int x,int y)384 tcl_KeyboardUpFunc (unsigned char key, int x, int y)
385 {
386 Tcl_Interp *interp;
387
388 if (!keyboard_up_cb.interp)
389 return;
390 interp = keyboard_up_cb.interp;
391
392 Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
393 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
394 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
395 Tcl_ObjSetVar2 (interp, obj_value, NULL,
396 Tcl_NewIntObj(keyboard_up_cb.value), 0);
397
398 tcl_InvokeCallback (&keyboard_up_cb);
399 }
400
401 void
tcl_SpecialFunc(int key,int x,int y)402 tcl_SpecialFunc (int key, int x, int y)
403 {
404 Tcl_Interp *interp;
405
406 if (!special_cb.interp)
407 return;
408 interp = special_cb.interp;
409
410 Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
411 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
412 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
413 Tcl_ObjSetVar2 (interp, obj_value, NULL,
414 Tcl_NewIntObj(special_cb.value), 0);
415
416 tcl_InvokeCallback (&special_cb);
417 }
418
419 void
tcl_SpecialUpFunc(int key,int x,int y)420 tcl_SpecialUpFunc (int key, int x, int y)
421 {
422 Tcl_Interp *interp;
423
424 if (!special_up_cb.interp)
425 return;
426 interp = special_up_cb.interp;
427
428 Tcl_ObjSetVar2 (interp, obj_key, NULL, Tcl_NewIntObj(key), 0);
429 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
430 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
431 Tcl_ObjSetVar2 (interp, obj_value, NULL,
432 Tcl_NewIntObj(special_up_cb.value), 0);
433
434 tcl_InvokeCallback (&special_up_cb);
435 }
436
437 void
tcl_MouseFunc(int button,int state,int x,int y)438 tcl_MouseFunc (int button, int state, int x, int y)
439 {
440 Tcl_Interp *interp;
441
442 if (!mouse_cb.interp)
443 return;
444 interp = mouse_cb.interp;
445
446 Tcl_ObjSetVar2 (interp, obj_button, NULL, Tcl_NewIntObj(button), 0);
447 Tcl_ObjSetVar2 (interp, obj_state, NULL, Tcl_NewIntObj(state), 0);
448 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
449 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
450 Tcl_ObjSetVar2 (interp, obj_value, NULL,
451 Tcl_NewIntObj(mouse_cb.value), 0);
452
453 tcl_InvokeCallback (&mouse_cb);
454 }
455
456 void
tcl_MotionFunc(int x,int y)457 tcl_MotionFunc (int x, int y)
458 {
459 Tcl_Interp *interp;
460
461 if (!motion_cb.interp)
462 return;
463 interp = motion_cb.interp;
464
465 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
466 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
467 Tcl_ObjSetVar2 (interp, obj_value, NULL,
468 Tcl_NewIntObj(motion_cb.value), 0);
469
470 tcl_InvokeCallback (&motion_cb);
471 }
472
473 void
tcl_PassiveMotionFunc(int x,int y)474 tcl_PassiveMotionFunc (int x, int y)
475 {
476 Tcl_Interp *interp;
477
478 if (!passive_motion_cb.interp)
479 return;
480 interp = passive_motion_cb.interp;
481
482 Tcl_ObjSetVar2 (interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
483 Tcl_ObjSetVar2 (interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
484 Tcl_ObjSetVar2 (interp, obj_value, NULL,
485 Tcl_NewIntObj(passive_motion_cb.value), 0);
486
487 tcl_InvokeCallback (&passive_motion_cb);
488 }
489
490 void
tcl_EntryFunc(int state)491 tcl_EntryFunc (int state)
492 {
493 Tcl_Interp *interp;
494
495 if (!entry_cb.interp)
496 return;
497 interp = entry_cb.interp;
498
499 Tcl_ObjSetVar2 (interp, obj_state, NULL, Tcl_NewIntObj(state), 0);
500 Tcl_ObjSetVar2 (interp, obj_value, NULL,
501 Tcl_NewIntObj(entry_cb.value), 0);
502
503 tcl_InvokeCallback (&entry_cb);
504 }
505
506 void
tcl_VisibilityFunc(int state)507 tcl_VisibilityFunc (int state)
508 {
509 Tcl_Interp *interp;
510
511 if (!visibility_cb.interp)
512 return;
513 interp = visibility_cb.interp;
514
515 Tcl_ObjSetVar2 (interp, obj_state, NULL,
516 Tcl_NewIntObj(state), 0);
517 Tcl_ObjSetVar2 (interp, obj_value, NULL,
518 Tcl_NewIntObj(visibility_cb.value), 0);
519
520 tcl_InvokeCallback (&visibility_cb);
521 }
522
523 void
tcl_TimerFunc(int value)524 tcl_TimerFunc (int value)
525 {
526 TclGlutCallback *cb;
527 Tcl_Interp *interp;
528 Tcl_Obj *script;
529
530 cb = tcl_GetGlutCallback (&glut_timer_hash, value);
531 if (!cb || !cb->obj)
532 return;
533
534 interp = cb->interp;
535 script = cb->obj;
536 cb->obj = NULL;
537
538 Tcl_ObjSetVar2 (interp, obj_value, NULL, Tcl_NewIntObj(value), 0);
539
540 if (Tcl_EvalObj (interp, script) == TCL_ERROR)
541 fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
542
543 Tcl_DecrRefCount (script);
544 }
545
546 void
tcl_IdleFunc(void)547 tcl_IdleFunc (void)
548 {
549 Tcl_Interp *interp;
550
551 if (!idle_cb.interp)
552 return;
553 interp = idle_cb.interp;
554
555 if (Tcl_EvalObj (interp, idle_cb.obj) == TCL_ERROR)
556 fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
557 }
558
559 void
tcl_MenuStateFunc(int state)560 tcl_MenuStateFunc (int state)
561 {
562 Tcl_ObjSetVar2 (menu_state_cb.interp, obj_state, NULL,
563 Tcl_NewIntObj(state), 0);
564 Tcl_ObjSetVar2 (menu_state_cb.interp, obj_value, NULL,
565 Tcl_NewIntObj(menu_state_cb.value), 0);
566
567 if (Tcl_EvalObj (menu_state_cb.interp, menu_state_cb.obj) == TCL_ERROR)
568 fputs (Tcl_GetVar (menu_state_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
569 stderr);
570 }
571
572 void
tcl_TabletMotionFunc(int x,int y)573 tcl_TabletMotionFunc (int x, int y)
574 {
575 Tcl_ObjSetVar2 (tablet_motion_cb.interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
576 Tcl_ObjSetVar2 (tablet_motion_cb.interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
577 Tcl_ObjSetVar2 (tablet_motion_cb.interp, obj_value, NULL,
578 Tcl_NewIntObj(tablet_motion_cb.value), 0);
579
580 if (Tcl_EvalObj (tablet_motion_cb.interp, tablet_motion_cb.obj)
581 == TCL_ERROR)
582 fputs (Tcl_GetVar (tablet_motion_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
583 stderr);
584 }
585
586 void
tcl_TabletButtonFunc(int button,int state,int x,int y)587 tcl_TabletButtonFunc (int button, int state, int x, int y)
588 {
589 Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_button, NULL,
590 Tcl_NewIntObj(button), 0);
591 Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_state, NULL,
592 Tcl_NewIntObj(state), 0);
593 Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
594 Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
595 Tcl_ObjSetVar2 (tablet_button_cb.interp, obj_value, NULL,
596 Tcl_NewIntObj(tablet_button_cb.value), 0);
597
598 if (Tcl_EvalObj (tablet_button_cb.interp, tablet_button_cb.obj)
599 == TCL_ERROR)
600 fputs (Tcl_GetVar (tablet_button_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
601 stderr);
602 }
603
604 void
tcl_MenuStatusFunc(int status,int x,int y)605 tcl_MenuStatusFunc (int status, int x, int y)
606 {
607 Tcl_ObjSetVar2 (menu_status_cb.interp, obj_status, NULL,
608 Tcl_NewIntObj(status), 0);
609 Tcl_ObjSetVar2 (menu_status_cb.interp, obj_x, NULL, Tcl_NewIntObj(x), 0);
610 Tcl_ObjSetVar2 (menu_status_cb.interp, obj_y, NULL, Tcl_NewIntObj(y), 0);
611 Tcl_ObjSetVar2 (menu_status_cb.interp, obj_value, NULL,
612 Tcl_NewIntObj(menu_status_cb.value), 0);
613
614 if (Tcl_EvalObj (menu_status_cb.interp, menu_status_cb.obj) == TCL_ERROR)
615 fputs (Tcl_GetVar (menu_status_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
616 stderr);
617 }
618
619 void
tcl_WindowStatusFunc(int state)620 tcl_WindowStatusFunc (int state)
621 {
622 Tcl_ObjSetVar2 (window_status_cb.interp, obj_state, NULL,
623 Tcl_NewIntObj(state), 0);
624 Tcl_ObjSetVar2 (window_status_cb.interp, obj_value, NULL,
625 Tcl_NewIntObj(window_status_cb.value), 0);
626
627 if (Tcl_EvalObj (window_status_cb.interp, window_status_cb.obj)
628 == TCL_ERROR)
629 fputs (Tcl_GetVar (window_status_cb.interp, "errorInfo", TCL_GLOBAL_ONLY),
630 stderr);
631 }
632
633 static GrObjectDrawOption
gr_get_draw_option(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])634 gr_get_draw_option (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
635 {
636 char *str;
637 int i;
638 GrObjectDrawOption option = 0, newopt = 0;
639 int invert;
640
641 for (i=0; i<objc; i++) {
642 invert = 0;
643 str = Tcl_GetStringFromObj (objv[i], NULL);
644 if (str[0] == '!') {
645 invert = 1;
646 str++;
647 }
648 if (!strcmp (str, "all")) {
649 newopt = GR_OBJECT_ALL;
650 } else if (!strcmp (str, "normal")) {
651 newopt = GR_OBJECT_NORMAL;
652 } else if (!strcmp (str, "color")) {
653 newopt = GR_OBJECT_COLOR;
654 } else if (!strcmp (str, "texture")) {
655 newopt = GR_OBJECT_TEXTURE;
656 } else if (!strcmp (str, "mipmap")) {
657 newopt = GR_OBJECT_MIPMAP;
658 } else if (!strcmp (str, "material")) {
659 newopt = GR_OBJECT_MATERIAL;
660 } else if (!strcmp (str, "flat")) {
661 newopt = GR_OBJECT_FLAT;
662 } else if (!strcmp (str, "smooth")) {
663 newopt = GR_OBJECT_SMOOTH;
664 } else if (!strcmp (str, "mag_nearest")) {
665 newopt = GR_OBJECT_MAG_NEAREST;
666 } else if (!strcmp (str, "mag_linear")) {
667 newopt = GR_OBJECT_MAG_LINEAR;
668 } else if (!strcmp (str, "min_nearest")) {
669 newopt = GR_OBJECT_MIN_NEAREST;
670 } else if (!strcmp (str, "min_linear")) {
671 newopt = GR_OBJECT_MIN_LINEAR;
672 }
673 if (invert) {
674 option &= ~newopt;
675 } else {
676 option |= newopt;
677 }
678 }
679
680 return option;
681 }
682
683 static void
tcl_GrObjectLoadTexture(Tcl_Interp * interp,char * baseurl,GrObject * obj,int recursive)684 tcl_GrObjectLoadTexture (Tcl_Interp *interp,
685 char *baseurl,
686 GrObject *obj,
687 int recursive)
688 {
689 int i;
690 char *str;
691 char *filename;
692
693 if (obj->texture_name) {
694 if (Tcl_VarEval (interp, "cache::fullurl ",
695 obj->texture_name, " ", baseurl, NULL) == TCL_ERROR) {
696 fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
697 goto PASS;
698 }
699
700 str = Tcl_GetStringResult (interp);
701 if (Tcl_VarEval (interp, "cache::get ", str, NULL) == TCL_ERROR) {
702 fputs (Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY), stderr);
703 goto PASS;
704 }
705
706 filename = Tcl_GetStringResult (interp);
707 if (!(obj->texture = tcl_GetCache (filename))) {
708 obj->texture = gr_texture_new_from_file (filename);
709 if (!obj->texture) {
710 fputs ("can not load texture\n", stderr);
711 goto PASS;
712 }
713 tcl_PutCache (filename, obj->texture);
714 }
715 gr_INCREF (obj->texture);
716 }
717
718 PASS:
719
720 if (recursive) {
721 for (i=0; i<obj->num_kids; i++) {
722 tcl_GrObjectLoadTexture (interp, baseurl, obj->kids[i], 1);
723 }
724 }
725 }
726
727 void
tcl_GrSceneLoadTexture(Tcl_Interp * interp,char * baseurl,GrScene * scene)728 tcl_GrSceneLoadTexture (Tcl_Interp *interp, char *baseurl, GrScene *scene)
729 {
730 int i;
731
732 for (i=0; i<scene->num_objs; i++) {
733 tcl_GrObjectLoadTexture (interp, baseurl, scene->objs[i], 1);
734 }
735 }
736
tcl_GetGrScene(Tcl_Interp * interp,char * name,char * baseurl)737 GrScene *tcl_GetGrScene (Tcl_Interp *interp, char *name, char *baseurl)
738 {
739 GrScene *scene;
740 char *fullurl;
741 char *str;
742 int res;
743 FILE *file;
744
745 if (!name)
746 return NULL;
747
748 if (baseurl) {
749 Tcl_VarEval (interp, "cache::fullurl ", name, " ", baseurl, NULL);
750 fullurl = strdup (Tcl_GetStringResult (interp));
751 } else {
752 fullurl = strdup (name);
753 }
754
755 res = Tcl_VarEval (interp, "cache::get ", fullurl, NULL);
756 if (res == TCL_ERROR) {
757 free (fullurl);
758 return NULL;
759 }
760 str = Tcl_GetStringResult (interp);
761
762 scene = tcl_GetCache (str);
763 if (!scene) {
764 file = fopen (str, "r");
765 if (!file) {
766 Tcl_AppendResult (interp, ": couldn't open file.", NULL);
767 free (fullurl);
768 return NULL;
769 }
770 scene = gr_scene_new_from_file (file);
771 fclose (file);
772 if (!scene) {
773 Tcl_AppendResult (interp, ": failed to read scene file.", NULL);
774 free (fullurl);
775 return NULL;
776 }
777 tcl_PutCache (str, scene);
778
779 tcl_GrSceneLoadTexture (interp, fullurl, scene);
780 }
781 free (fullurl);
782 gr_INCREF (scene);
783
784 return scene;
785 }
786
787 static int
grSceneCmd(ClientData cdata,Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])788 grSceneCmd (ClientData cdata,
789 Tcl_Interp *interp,
790 int objc,
791 Tcl_Obj *CONST objv[])
792 {
793 Tcl_HashEntry *entry;
794 static int count = 0;
795 GrScene *scene;
796 char *filename;
797 char *url;
798 int _new;
799 char buf[256];
800 FILE *file;
801 GrObjectDrawOption option;
802 GrObject *object;
803 char *str;
804 int key;
805 double sx, sy, sz;
806
807 if (objc < 2) {
808 goto ERROR;
809 }
810
811 str = Tcl_GetStringFromObj (objv[1], NULL);
812 if (!strcmp (str, "create")) {
813 if (objc < 3)
814 goto ERROR;
815 url = Tcl_GetStringFromObj (objv[2], NULL);
816 filename = Tcl_GetStringResult (interp);
817 if (Tcl_VarEval (interp, "cache::get ", url, NULL) == TCL_ERROR) {
818 return TCL_ERROR;
819 }
820 filename = Tcl_GetStringResult (interp);
821 scene = tcl_GetCache (filename);
822 if (!scene) {
823 file = fopen (filename, "r");
824 if (!file) {
825 OBJ_RESULT(objv[0], ": couldn't open file.");
826 return TCL_ERROR;
827 }
828 scene = gr_scene_new_from_file (file);
829 fclose (file);
830 if (!scene) {
831 OBJ_RESULT(objv[0], ": couldn't create scene data.");
832 return TCL_ERROR;
833 }
834 tcl_GrSceneLoadTexture (interp, url, scene);
835 }
836 gr_INCREF (scene);
837
838 sprintf (buf, "%d", count);
839 entry = Tcl_CreateHashEntry (&scene_hash, (ClientData)count++, &_new);
840 Tcl_SetHashValue (entry, (ClientData *) scene);
841 Tcl_SetResult (interp, buf, TCL_VOLATILE);
842 return TCL_OK;
843
844 } else if (!strcmp (str, "destroy")) {
845 if (objc < 3)
846 goto ERROR;
847 Tcl_GetIntFromObj (interp, objv[2], &key);
848 entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
849 if (!entry) {
850 OBJ_RESULT(objv[0], ": scene does not defined.");
851 return TCL_ERROR;
852 }
853 scene = (GrScene *) Tcl_GetHashValue (entry);
854 gr_DECREF (scene);
855 Tcl_DeleteHashEntry (entry);
856
857 } else if (!strcmp (str, "setup")) {
858 if (objc < 3)
859 goto ERROR;
860 Tcl_GetIntFromObj (interp, objv[2], &key);
861 entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
862 if (!entry) {
863 OBJ_RESULT(objv[0], ": scene does not defined.");
864 return TCL_ERROR;
865 }
866 scene = (GrScene *) Tcl_GetHashValue (entry);
867 option = gr_get_draw_option (interp, objc - 3, objv + 3);
868 if (option == 0) {
869 option = GR_OBJECT_ALL;
870 }
871 gr_scene_setup_gl (scene, option);
872
873 } else if (!strcmp (str, "release")) {
874 if (objc < 3)
875 goto ERROR;
876 Tcl_GetIntFromObj (interp, objv[2], &key);
877 entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
878 if (!entry) {
879 OBJ_RESULT(objv[0], ": scene does not defined.");
880 return TCL_ERROR;
881 }
882 scene = (GrScene *) Tcl_GetHashValue (entry);
883 gr_scene_release_gl (scene);
884
885 } else if (!strcmp (str, "draw")) {
886 if (objc < 3)
887 goto ERROR;
888 Tcl_GetIntFromObj (interp, objv[2], &key);
889 entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
890 if (!entry) {
891 OBJ_RESULT(objv[0], ": scene does not defined.");
892 return TCL_ERROR;
893 }
894 scene = (GrScene *) Tcl_GetHashValue (entry);
895 str = Tcl_GetStringFromObj (objv[3], NULL);
896 object = NULL;
897 if (!strcmp(str, "-obj")) {
898 str = Tcl_GetStringFromObj (objv[4], NULL);
899 object = gr_scene_find_object (scene, str, NULL);
900 option = gr_get_draw_option (interp, objc - 5, objv + 5);
901 } else {
902 option = gr_get_draw_option (interp, objc - 3, objv + 3);
903 }
904 if (option == 0) {
905 option = GR_OBJECT_ALL;
906 }
907 glPushMatrix ();
908 gr_scene_draw (scene, object, option, 1);
909 glPopMatrix ();
910
911 } else if (!strcmp (str, "scale")) {
912 if (objc < 6)
913 goto ERROR;
914 Tcl_GetIntFromObj (interp, objv[2], &key);
915 entry = Tcl_FindHashEntry (&scene_hash, (ClientData)key);
916 if (!entry) {
917 OBJ_RESULT(objv[0], ": scene does not defined.");
918 return TCL_ERROR;
919 }
920 scene = (GrScene *) Tcl_GetHashValue (entry);
921 Tcl_GetDoubleFromObj (interp, objv[3], &sx);
922 Tcl_GetDoubleFromObj (interp, objv[4], &sy);
923 Tcl_GetDoubleFromObj (interp, objv[5], &sz);
924 gr_scene_scale (scene, sx, sy, sz);
925 } else {
926 goto ERROR;
927 }
928 return TCL_OK;
929
930 ERROR:
931 OBJ_RESULT (objv[0],
932 ": wrong args. should be create <url>, destroy <scene>, setup <scene>, "
933 "release <scene>, draw <scene>, or scale <scene> <sx> <sy> <sz>.\n");
934 return TCL_ERROR;
935 }
936
937 #include <X11/Xlib.h>
938 extern Display *__glutDisplay;
939 extern Window __glutRoot;
940 extern struct GLUTwindow *__glutCurrentWindow;
941
942 #if 0
943 static Tcl_Obj*
944 ObjFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
945 {
946 Tcl_Obj *item = NULL;
947
948 Tcl_ListObjIndex (interp, list, index, &item);
949 return item;
950 }
951
952 static int
953 IntFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
954 {
955 Tcl_Obj *item;
956 int val = 0;
957
958 if (Tcl_ListObjIndex (interp, list, index, &item) == TCL_ERROR)
959 return 0.0;
960 Tcl_GetIntFromObj (interp, item, &val);
961
962 return val;
963 }
964 #endif
965
966 static double
DoubleFromList(Tcl_Interp * interp,Tcl_Obj * list,int index)967 DoubleFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
968 {
969 Tcl_Obj *item;
970 double val = 0.0;
971
972 if (Tcl_ListObjIndex (interp, list, index, &item) == TCL_ERROR)
973 return 0.0;
974 Tcl_GetDoubleFromObj (interp, item, &val);
975
976 return val;
977 }
978
979 #if 0
980 static char *
981 StringFromList (Tcl_Interp *interp, Tcl_Obj *list, int index)
982 {
983 Tcl_Obj *item;
984
985 if (Tcl_ListObjIndex (interp, list, index, &item) == TCL_ERROR)
986 return NULL;
987
988 return Tcl_GetStringFromObj (item, NULL);
989 }
990
991 static int
992 CheckNumArg (Tcl_Interp *interp, Tcl_Obj *arg, int num, char *message)
993 {
994 int argc;
995
996 if (Tcl_ListObjLength (interp, arg, &argc) == TCL_ERROR)
997 return TCL_ERROR;
998
999 if (argc != num) {
1000 Tcl_AppendResult (interp, " ",
1001 StringFromList (interp, arg, 0),
1002 ": wrong # args. ", message, NULL);
1003 return TCL_ERROR;
1004 }
1005
1006 return TCL_OK;
1007 }
1008 #endif
1009
1010 GLenum
GetGLEnum(Tcl_Obj * CONST obj)1011 GetGLEnum (Tcl_Obj *CONST obj)
1012 {
1013 char *str;
1014 Tcl_HashEntry *entry;
1015
1016 str = Tcl_GetStringFromObj (obj, NULL);
1017 if (!str)
1018 return GL_NONE;
1019
1020 entry = Tcl_FindHashEntry (&gl_enum_hash, str);
1021 if (!entry)
1022 return GL_NONE;
1023
1024 return (GLenum) Tcl_GetHashValue (entry);
1025 }
1026
1027 void *
GetGlutEnum(Tcl_Obj * CONST obj)1028 GetGlutEnum (Tcl_Obj *CONST obj)
1029 {
1030 char *str;
1031 Tcl_HashEntry *entry;
1032
1033 str = Tcl_GetStringFromObj (obj, NULL);
1034 if (!str)
1035 return GL_NONE;
1036
1037 entry = Tcl_FindHashEntry (&glut_enum_hash, str);
1038 if (!entry)
1039 return GL_NONE;
1040
1041 return (void *) Tcl_GetHashValue (entry);
1042 }
1043
1044
1045 static int
gl_subcmd_vertex(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1046 gl_subcmd_vertex (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1047 {
1048 double v[4];
1049
1050 if (objc < 3) goto ERROR;
1051 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &v[0]), ERROR);
1052 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &v[1]), ERROR);
1053 if (objc < 4 || Tcl_GetDoubleFromObj (interp, objv[3], &v[2]) == TCL_ERROR) {
1054 glVertex2dv (v);
1055 return 3;
1056 }
1057 if (objc < 5 || Tcl_GetDoubleFromObj (interp, objv[4], &v[3]) == TCL_ERROR) {
1058 glVertex3dv (v);
1059 return 4;
1060 } else {
1061 glVertex4dv (v);
1062 return 5;
1063 }
1064
1065 ERROR:
1066 OBJ_RESULT (objv[0], ": wrong # args. should be x y [z [w]]");
1067 return 0;
1068 }
1069
1070 static int
gl_subcmd_normal(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1071 gl_subcmd_normal (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1072 {
1073 double v[3];
1074
1075 if (objc < 4) goto ERROR;
1076 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &v[0]), ERROR);
1077 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &v[1]), ERROR);
1078 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &v[2]), ERROR);
1079
1080 glNormal3dv (v);
1081 return 4;
1082
1083 ERROR:
1084 OBJ_RESULT (objv[0], ": wrong # args. should be nx ny nz.");
1085 return 0;
1086 }
1087
1088 static int
gl_subcmd_color(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1089 gl_subcmd_color (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1090 {
1091 double c[4];
1092
1093 if (objc < 4) goto ERROR;
1094 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &c[0]), ERROR);
1095 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &c[1]), ERROR);
1096 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &c[2]), ERROR);
1097 if (objc < 5 || Tcl_GetDoubleFromObj (interp, objv[4], &c[3]) == TCL_ERROR) {
1098 glColor3dv (c);
1099 return 4;
1100 } else {
1101 glColor4dv (c);
1102 return 5;
1103 }
1104
1105 ERROR:
1106 OBJ_RESULT (objv[0], ": wrong # args. r g b [a]");
1107 return 0;
1108 }
1109
1110 static int
gl_subcmd_enable(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1111 gl_subcmd_enable (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1112 {
1113 GLenum attr;
1114 int i;
1115 char *str;
1116
1117 for (i=1; i < objc; i++) {
1118 str = Tcl_GetStringFromObj (objv[i], NULL);
1119 if (str && str[0] == '-') {
1120 return i;
1121 }
1122 attr = GetGLEnum (objv[i]);
1123 if (attr == GL_NONE) {
1124 Tcl_SetObjResult (interp, objv[0]);
1125 Tcl_AppendResult (interp, ": unknown attribute \"", str, "\".", NULL);
1126 return 0;
1127 }
1128 GL_CHECK(glEnable (attr));
1129 }
1130
1131 return i;
1132 }
1133
1134 static int
gl_subcmd_deletelists(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1135 gl_subcmd_deletelists (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1136 {
1137 int list;
1138 int range;
1139
1140 if (objc < 3) {
1141 OBJ_RESULT (objv[0], ": wrong # args. should be <name> <range>");
1142 return 0;
1143 }
1144
1145 TCL_CHECK (Tcl_GetIntFromObj (interp, objv[1], &list), ERROR);
1146 TCL_CHECK (Tcl_GetIntFromObj (interp, objv[2], &range), ERROR);
1147
1148 GL_CHECK(glDeleteLists (list, range));
1149
1150 return 3;
1151
1152 ERROR:
1153 OBJ_RESULT (objv[0], ": wrong args. should be integer value.");
1154 return 0;
1155 }
1156
1157 static int
gl_subcmd_deletetextures(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1158 gl_subcmd_deletetextures (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1159 {
1160 int i;
1161 int val;
1162
1163 for (i=1; i<objc; i++) {
1164 if (Tcl_GetIntFromObj (interp, objv[i], &val) == TCL_ERROR)
1165 break;
1166 GL_CHECK(glDeleteTextures (1, &val));
1167 }
1168
1169 if (i==1) {
1170 OBJ_RESULT (objv[0], ": wrong # args. should be tex [tex ...]");
1171 return 0;
1172 }
1173
1174 return i;
1175 }
1176
1177 static int
gl_subcmd_disable(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1178 gl_subcmd_disable (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1179 {
1180 GLenum attr;
1181 int i;
1182 char *str;
1183
1184 for (i=1; i < objc; i++) {
1185 str = Tcl_GetStringFromObj (objv[i], NULL);
1186 if (str && str[0] == '-') {
1187 return i;
1188 }
1189 attr = GetGLEnum (objv[i]);
1190 if (attr == GL_NONE) {
1191 Tcl_SetObjResult (interp, objv[0]);
1192 Tcl_AppendResult (interp, ": unknown attribute \"", str, "\".", NULL);
1193 return 0;
1194 }
1195 GL_CHECK(glDisable (attr));
1196 }
1197
1198 return i;
1199 }
1200
1201 static int
gl_subcmd_begin(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1202 gl_subcmd_begin (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1203 {
1204 GLenum mode;
1205
1206 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
1207
1208 glBegin (mode);
1209 return 2;
1210
1211 ERROR:
1212 OBJ_RESULT (objv[0], ": couldn't get valid primitive type.");
1213 return 0;
1214 }
1215
1216 static int
gl_subcmd_end(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1217 gl_subcmd_end (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1218 {
1219 GL_CHECK(glEnd ());
1220
1221 return 1;
1222 }
1223
1224 static int
gl_subcmd_translate(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1225 gl_subcmd_translate (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1226 {
1227 double x, y, z;
1228
1229 if (objc < 4) goto ERROR;
1230 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &x), ERROR);
1231 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &y), ERROR);
1232 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &z), ERROR);
1233
1234 GL_CHECK(glTranslated (x, y, z));
1235 return 4;
1236
1237 ERROR:
1238 OBJ_RESULT (objv[0], ": wrong # args. should be x y z.");
1239 return 0;
1240 }
1241
1242 static int
gl_subcmd_rotate(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1243 gl_subcmd_rotate (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1244 {
1245 double x, y, z, angle;
1246
1247 if (objc < 5) goto ERROR;
1248 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &angle), ERROR);
1249 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &x), ERROR);
1250 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &y), ERROR);
1251 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &z), ERROR);
1252
1253 GL_CHECK(glRotated (angle, x, y, z));
1254 return 5;
1255
1256 ERROR:
1257 OBJ_RESULT (objv[0], ": wrong # args. should be angle x y z.");
1258 return 0;
1259 }
1260
1261 static int
gl_subcmd_scale(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1262 gl_subcmd_scale (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1263 {
1264 double x, y, z;
1265
1266 if (objc < 4) goto ERROR;
1267 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &x), ERROR);
1268 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &y), ERROR);
1269 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &z), ERROR);
1270
1271 GL_CHECK(glScaled (x, y, z));
1272 return 4;
1273
1274 ERROR:
1275 OBJ_RESULT (objv[0], ": wrong # args. should be sx sy sz.");
1276 return 0;
1277 }
1278
1279 static int
gl_subcmd_loadidentity(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1280 gl_subcmd_loadidentity (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1281 {
1282 GL_CHECK(glLoadIdentity ());
1283
1284 return 1;
1285 }
1286
1287 static int
gl_subcmd_viewport(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1288 gl_subcmd_viewport (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1289 {
1290 double left, right, bottom, top;
1291
1292 if (objc < 5) goto ERROR;
1293 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &left), ERROR);
1294 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &right), ERROR);
1295 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &bottom), ERROR);
1296 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &top), ERROR);
1297
1298 GL_CHECK(glViewport (left, right, bottom, top));
1299 return 5;
1300
1301 ERROR:
1302 OBJ_RESULT (objv[0], ": wrong # args. should be left right bottom top.");
1303 return 0;
1304 }
1305
1306 static int
gl_subcmd_frustum(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1307 gl_subcmd_frustum (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1308 {
1309 double left, right, bottom, top, near, far;
1310
1311 if (objc < 7) goto ERROR;
1312 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &left), ERROR);
1313 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &right), ERROR);
1314 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &bottom), ERROR);
1315 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &top), ERROR);
1316 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &near), ERROR);
1317 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &far), ERROR);
1318
1319 GL_CHECK(glFrustum (left, right, bottom, top, near, far));
1320 return 7;
1321
1322 ERROR:
1323 OBJ_RESULT (objv[0], ": wrong # args. should be "
1324 "left right bottom top near far.");
1325 return 0;
1326 }
1327
1328 static int
gl_subcmd_ortho(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1329 gl_subcmd_ortho (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1330 {
1331 double left, right, bottom, top, near, far;
1332
1333 if (objc < 7) goto ERROR;
1334 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &left), ERROR);
1335 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &right), ERROR);
1336 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &bottom), ERROR);
1337 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &top), ERROR);
1338 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &near), ERROR);
1339 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &far), ERROR);
1340
1341 GL_CHECK(glOrtho (left, right, bottom, top, near, far));
1342 return 7;
1343
1344 ERROR:
1345 OBJ_RESULT (objv[0], ": wrong # args. should be "
1346 "left right bottom top near far.");
1347 return 0;
1348 }
1349
1350 static int
gl_subcmd_matrixmode(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1351 gl_subcmd_matrixmode (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1352 {
1353 GLenum mode;
1354
1355 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
1356
1357 GL_CHECK(glMatrixMode (mode));
1358 return 2;
1359
1360 ERROR:
1361 OBJ_RESULT (objv[0], ": couldn't get valid mode.");
1362 return 0;
1363 }
1364
1365 static int
gl_subcmd_clearcolor(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1366 gl_subcmd_clearcolor (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1367 {
1368 double r, g, b, a;
1369
1370 if (objc < 5) goto ERROR;
1371 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
1372 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
1373 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
1374 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
1375
1376 GL_CHECK(glClearColor (r, g, b, a));
1377 return 5;
1378
1379 ERROR:
1380 OBJ_RESULT (objv[0], ": wrong # args. should be r g b a.");
1381 return 0;
1382 }
1383
1384 static int
gl_subcmd_clear(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1385 gl_subcmd_clear (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1386 {
1387 GLbitfield mask = 0, res;
1388 int i;
1389 char *str;
1390
1391 if (objc < 2) {
1392 Tcl_SetObjResult (interp, objv[0]);
1393 Tcl_AppendResult (interp, ": wrong # args. mode [mode ...].", NULL);
1394 return 0;
1395 }
1396
1397 for (i=1; i<objc; i++) {
1398 str = Tcl_GetStringFromObj (objv[i], NULL);
1399 if (str && str[0] == '-')
1400 break;
1401 ENUM_CHECK((res = GetGLEnum (objv[i])), ERROR);
1402 mask |= (GLbitfield) res;
1403 }
1404
1405 GL_CHECK(glClear (mask));
1406 return i;
1407
1408 ERROR:
1409 Tcl_SetObjResult (interp, objv[0]);
1410 Tcl_AppendResult (interp, ": unkown mode \"", str, "\".", NULL);
1411 return 0;
1412 }
1413
1414 static int
gl_subcmd_genlists(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1415 gl_subcmd_genlists (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1416 {
1417 int num = 1;
1418 GLuint name;
1419 Tcl_Obj *val;
1420
1421 if (objc == 1) {
1422 Tcl_SetObjResult (interp, objv[0]);
1423 Tcl_AppendResult (interp, ": wrong # args. varName ?num?.", NULL);
1424 return 0;
1425 }
1426
1427 if (objc > 2 && Tcl_GetIntFromObj (interp, objv[2], &num) == TCL_ERROR) {
1428 Tcl_SetObjResult (interp, objv[0]);
1429 Tcl_AppendResult (interp, ": wrong args. num must be integer.", NULL);
1430 return 0;
1431 }
1432
1433 GL_CHECK(name = glGenLists (num));
1434
1435 val = Tcl_NewIntObj (name);
1436 Tcl_ObjSetVar2 (interp, objv[1], NULL, val, 0);
1437
1438 return (objc > 2)? 3:2;
1439 }
1440
1441 static int
gl_subcmd_newlist(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1442 gl_subcmd_newlist (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1443 {
1444 GLuint name;
1445 GLenum mode;
1446
1447 if (objc < 3) goto ERROR;
1448 TCL_CHECK (Tcl_GetIntFromObj (interp, objv[1], &name), ERROR);
1449 TCL_CHECK((mode = GetGLEnum (objv[2])), ERROR);
1450
1451 GL_CHECK(glNewList (name, mode));
1452
1453 return 3;
1454
1455 ERROR:
1456 Tcl_SetObjResult (interp, objv[0]);
1457 Tcl_AppendResult (interp, ": wrong args. should be id mode.", NULL);
1458 return 0;
1459 }
1460
1461 static int
gl_subcmd_endlist(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1462 gl_subcmd_endlist (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1463 {
1464 GL_CHECK(glEndList ());
1465 return 1;
1466 }
1467
1468 static int
gl_subcmd_calllist(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1469 gl_subcmd_calllist (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1470 {
1471 GLuint name;
1472 int i;
1473
1474 if (objc < 2) {
1475 Tcl_SetObjResult (interp, objv[0]);
1476 Tcl_AppendResult (interp, ": wrong # args. id [id ...].", NULL);
1477 return 0;
1478 }
1479
1480 for (i=1; i<objc; i++) {
1481 if (Tcl_GetIntFromObj (interp, objv[i], &name) == TCL_ERROR)
1482 break;
1483 GL_CHECK(glCallList (name));
1484 }
1485
1486 return i;
1487 }
1488
1489 static int
gl_subcmd_pushmatrix(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1490 gl_subcmd_pushmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1491 {
1492 GL_CHECK(glPushMatrix ());
1493 return 1;
1494 }
1495
1496 static int
gl_subcmd_popmatrix(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1497 gl_subcmd_popmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1498 {
1499 GL_CHECK(glPopMatrix ());
1500 return 1;
1501 }
1502
1503 static int
gl_subcmd_accum(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1504 gl_subcmd_accum (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1505 {
1506 double r, g, b, a;
1507
1508 if (objc < 5) goto ERROR;
1509 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
1510 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
1511 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
1512 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
1513
1514 GL_CHECK(glClearColor (r, g, b, a));
1515 return 5;
1516
1517 ERROR:
1518 Tcl_SetObjResult (interp, objv[0]);
1519 Tcl_AppendResult (interp, ": wrong # args. should be r g b a.", NULL);
1520 return 0;
1521 }
1522
1523 static int
gl_subcmd_alphafunc(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1524 gl_subcmd_alphafunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1525 {
1526 GLenum func;
1527 double ref;
1528
1529 if (objc < 3) goto ERROR;
1530 ENUM_CHECK((func = GetGLEnum (objv[1])), ERROR);
1531 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &ref), ERROR);
1532
1533 GL_CHECK(glAlphaFunc (func, ref));
1534 return 3;
1535
1536 ERROR:
1537 Tcl_SetObjResult (interp, objv[0]);
1538 Tcl_AppendResult (interp, ": wrong # args. should be func ref.", NULL);
1539 return 0;
1540 }
1541
1542 static int
gl_subcmd_bindtexture(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1543 gl_subcmd_bindtexture (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1544 {
1545 GLenum target;
1546 int texture;
1547
1548 if (objc < 3) goto ERROR;
1549 ENUM_CHECK((target = GetGLEnum (objv[1])), ERROR);
1550 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &texture), ERROR);
1551
1552 GL_CHECK(glBindTexture (target, texture));
1553 return 3;
1554
1555 ERROR:
1556 OBJ_RESULT (objv[0], ": wrong # args. should be target texture.");
1557 return 0;
1558 }
1559
1560 static int
gl_subcmd_blendfunc(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1561 gl_subcmd_blendfunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1562 {
1563 GLenum sfactor;
1564 GLenum dfactor;
1565
1566 ENUM_CHECK((sfactor = GetGLEnum (objv[1])), ERROR);
1567 ENUM_CHECK((dfactor = GetGLEnum (objv[2])), ERROR);
1568
1569 GL_CHECK(glBlendFunc (sfactor, dfactor));
1570 return 3;
1571
1572 ERROR:
1573 Tcl_SetObjResult (interp, objv[0]);
1574 Tcl_AppendResult (interp, ": wrong # args. should be sfactor dfactor.", NULL);
1575 return 0;
1576 }
1577
1578 static int
gl_subcmd_clearaccum(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1579 gl_subcmd_clearaccum (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1580 {
1581 double r, g, b, a;
1582
1583 if (objc < 5) goto ERROR;
1584 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
1585 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
1586 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
1587 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
1588
1589 GL_CHECK(glClearAccum (r, g, b, a));
1590 return 5;
1591
1592 ERROR:
1593 Tcl_SetObjResult (interp, objv[0]);
1594 Tcl_AppendResult (interp, ": wrong # args. should be r g b a.", NULL);
1595 return 0;
1596 }
1597
1598 static int
gl_subcmd_cleardepth(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1599 gl_subcmd_cleardepth (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1600 {
1601 double depth;
1602
1603 if (objc < 2) goto ERROR;
1604 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &depth), ERROR);
1605
1606 GL_CHECK(glClearDepth (depth));
1607 return 2;
1608
1609 ERROR:
1610 Tcl_SetObjResult (interp, objv[0]);
1611 Tcl_AppendResult (interp, ": wrong # args. should be depth.", NULL);
1612 return 0;
1613 }
1614
1615 static int
gl_subcmd_clearstencil(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1616 gl_subcmd_clearstencil (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1617 {
1618 int stencil;
1619
1620 if (objc < 2) goto ERROR;
1621 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &stencil), ERROR);
1622
1623 GL_CHECK(glClearStencil (stencil));
1624 return 2;
1625
1626 ERROR:
1627 Tcl_SetObjResult (interp, objv[0]);
1628 Tcl_AppendResult (interp, ": wrong # args. should be stencil.", NULL);
1629 return 0;
1630 }
1631
1632 static int
gl_subcmd_copypixels(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1633 gl_subcmd_copypixels (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1634 {
1635 int x, y;
1636 int width, height;
1637 GLenum type;
1638
1639 if (objc < 5) goto ERROR;
1640 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &x), ERROR);
1641 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &y), ERROR);
1642 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &width), ERROR);
1643 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &height), ERROR);
1644 ENUM_CHECK((type = GetGLEnum (objv[5])), ERROR);
1645
1646 GL_CHECK(glCopyPixels (x, y, width, height, type));
1647 return 6;
1648
1649 ERROR:
1650 Tcl_SetObjResult (interp, objv[0]);
1651 Tcl_AppendResult (interp, ": wrong # args. should be x y w h type.", NULL);
1652 return 0;
1653 }
1654
1655 static int
gl_subcmd_clipplane(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1656 gl_subcmd_clipplane (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1657 {
1658 GLenum plane;
1659 GLdouble eq[4];
1660
1661 if (objc < 6) goto ERROR;
1662 ENUM_CHECK((plane = GetGLEnum (objv[1])), ERROR);
1663 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &eq[0]), ERROR);
1664 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &eq[1]), ERROR);
1665 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &eq[2]), ERROR);
1666 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &eq[3]), ERROR);
1667
1668 GL_CHECK(glClipPlane (plane, eq));
1669 return 6;
1670
1671 ERROR:
1672 Tcl_SetObjResult (interp, objv[0]);
1673 Tcl_AppendResult (interp, ": wrong # args. should be plane a b c d.", NULL);
1674 return 0;
1675 }
1676
1677 static int
gl_subcmd_colormask(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1678 gl_subcmd_colormask (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1679 {
1680 double r, g, b, a;
1681
1682 if (objc < 5) goto ERROR;
1683 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &r), ERROR);
1684 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &g), ERROR);
1685 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &b), ERROR);
1686 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &a), ERROR);
1687
1688 GL_CHECK(glColorMask (r, g, b, a));
1689 return 5;
1690
1691 ERROR:
1692 Tcl_SetObjResult (interp, objv[0]);
1693 Tcl_AppendResult (interp, ": wrong # args. should be r g b a.", NULL);
1694 return 0;
1695 }
1696
1697 static int
gl_subcmd_colormaterial(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1698 gl_subcmd_colormaterial (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1699 {
1700 GLenum face, mode;
1701
1702 ENUM_CHECK((face = GetGLEnum (objv[1])), ERROR);
1703 ENUM_CHECK((mode = GetGLEnum (objv[2])), ERROR);
1704
1705 GL_CHECK(glColorMaterial (face, mode));
1706 return 3;
1707
1708 ERROR:
1709 Tcl_SetObjResult (interp, objv[0]);
1710 Tcl_AppendResult (interp, ": wrong # args. should be face mode.", NULL);
1711 return 0;
1712 }
1713
1714 static int
gl_subcmd_cullface(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1715 gl_subcmd_cullface (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1716 {
1717 GLenum mode;
1718
1719 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
1720
1721 GL_CHECK(glCullFace (mode));
1722 return 2;
1723
1724 ERROR:
1725 Tcl_SetObjResult (interp, objv[0]);
1726 Tcl_AppendResult (interp, ": wrong # args. should be mode.", NULL);
1727 return 0;
1728 }
1729
1730 static int
gl_subcmd_depthfunc(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1731 gl_subcmd_depthfunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1732 {
1733 GLenum func;
1734
1735 ENUM_CHECK((func = GetGLEnum (objv[1])), ERROR);
1736
1737 GL_CHECK(glDepthFunc (func));
1738 return 2;
1739
1740 ERROR:
1741 Tcl_SetObjResult (interp, objv[0]);
1742 Tcl_AppendResult (interp, ": wrong # args. should be func.", NULL);
1743 return 0;
1744 }
1745
1746 static int
gl_subcmd_depthmask(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1747 gl_subcmd_depthmask (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1748 {
1749 int flag;
1750
1751 if (objc < 2) goto ERROR;
1752 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &flag), ERROR);
1753
1754 GL_CHECK(glDepthMask (flag));
1755 return 2;
1756
1757 ERROR:
1758 Tcl_SetObjResult (interp, objv[0]);
1759 Tcl_AppendResult (interp, ": wrong # args. should be flag.", NULL);
1760 return 0;
1761 }
1762
1763 static int
gl_subcmd_drawbuffer(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1764 gl_subcmd_drawbuffer (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1765 {
1766 int mode;
1767
1768 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
1769
1770 GL_CHECK(glDrawBuffer (mode));
1771 return 2;
1772
1773 ERROR:
1774 Tcl_SetObjResult (interp, objv[0]);
1775 Tcl_AppendResult (interp, ": wrong # args. should be mode.", NULL);
1776 return 0;
1777 }
1778
1779 #if 0
1780 static int
1781 gl_subcmd_drawpixels (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1782 {
1783 char *name;
1784 GLenum format;
1785 Tk_PhotoHandle handle;
1786 Tk_PhotoImageBlock block;
1787
1788 if (objc < 3)
1789 goto ERROR;
1790
1791 ENUM_CHECK ((format = GetGLEnum (objv[1])), ERROR);
1792
1793 name = Tcl_GetStringFromObj (objv[2], NULL);
1794 if (!name)
1795 goto ERROR;
1796
1797 handle = Tk_FindPhoto (interp, name);
1798 if (!handle) {
1799 Tcl_SetObjResult (interp, objv[0]);
1800 Tcl_AppendResult (interp, ": photo not found.", NULL);
1801 return 0;
1802 }
1803
1804 if (Tk_PhotoGetImage (handle, &block) != 1) {
1805 Tcl_SetObjResult (interp, objv[0]);
1806 Tcl_AppendResult (interp, ": couldn't get image of photo.", NULL);
1807 return 0;
1808 }
1809 switch (format) {
1810 case GL_RGB:
1811 if (block.pixelSize != 3) goto TYPE_MISMATCH;
1812 break;
1813
1814 case GL_RGBA:
1815 if (block.pixelSize != 4) goto TYPE_MISMATCH;
1816 break;
1817
1818 case GL_RED:
1819 case GL_GREEN:
1820 case GL_BLUE:
1821 case GL_ALPHA:
1822 case GL_LUMINANCE:
1823 case GL_LUMINANCE_ALPHA:
1824 case GL_STENCIL_INDEX:
1825 case GL_DEPTH_COMPONENT:
1826 if (block.pixelSize != 1) goto TYPE_MISMATCH;
1827 break;
1828
1829 default:
1830 Tcl_SetObjResult (interp, objv[0]);
1831 Tcl_AppendResult (interp, ": wrong format.", NULL);
1832 return 0;
1833 }
1834
1835 GL_CHECK(glPixelStorei (GL_UNPACK_ALIGNMENT, 1));
1836 GL_CHECK(glDrawPixels (block.width, block.height,
1837 format, GL_UNSIGNED_BYTE, block.pixelPtr));
1838 return 3;
1839
1840 ERROR:
1841 Tcl_SetObjResult (interp, objv[0]);
1842 Tcl_AppendResult (interp, ": wrong # args. should be x y w h type.", NULL);
1843 return 0;
1844
1845 TYPE_MISMATCH:
1846 Tcl_SetObjResult (interp, objv[0]);
1847 Tcl_AppendResult (interp, ": type mismatch.", NULL);
1848 return 0;
1849
1850 }
1851 #endif
1852
1853 static int
gl_subcmd_edgeflag(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1854 gl_subcmd_edgeflag (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1855 {
1856 int flag;
1857
1858 if (objc < 2) goto ERROR;
1859 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &flag), ERROR);
1860 GL_CHECK(glEdgeFlag (flag));
1861 return 2;
1862
1863 ERROR:
1864 Tcl_SetObjResult (interp, objv[0]);
1865 Tcl_AppendResult (interp, ": wrong # args. should flag.", NULL);
1866 return 0;
1867 }
1868
1869 static int
gl_subcmd_evalcoord1(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1870 gl_subcmd_evalcoord1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1871 {
1872 double u;
1873
1874 if (objc < 2) goto ERROR;
1875 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &u), ERROR);
1876 GL_CHECK(glEvalCoord1d (u));
1877 return 2;
1878
1879 ERROR:
1880 Tcl_SetObjResult (interp, objv[0]);
1881 Tcl_AppendResult (interp, ": wrong # args. should u.", NULL);
1882 return 0;
1883 }
1884
1885 static int
gl_subcmd_evalcoord2(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1886 gl_subcmd_evalcoord2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1887 {
1888 double u, v;
1889
1890 if (objc < 3) goto ERROR;
1891 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &u), ERROR);
1892 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &v), ERROR);
1893 GL_CHECK(glEvalCoord2d (u, v));
1894 return 3;
1895
1896 ERROR:
1897 Tcl_SetObjResult (interp, objv[0]);
1898 Tcl_AppendResult (interp, ": wrong # args. should u v.", NULL);
1899 return 0;
1900 }
1901
1902 static int
gl_subcmd_evalmesh1(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1903 gl_subcmd_evalmesh1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1904 {
1905 GLenum mode;
1906 int i1, i2;
1907
1908 if (objc < 4) goto ERROR;
1909 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
1910 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &i1), ERROR);
1911 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &i2), ERROR);
1912 GL_CHECK(glEvalMesh1 (mode, i1, i2));
1913 return 4;
1914
1915 ERROR:
1916 Tcl_SetObjResult (interp, objv[0]);
1917 Tcl_AppendResult (interp, ": wrong # args. should mode i1 i2.", NULL);
1918 return 0;
1919 }
1920
1921 static int
gl_subcmd_evalmesh2(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1922 gl_subcmd_evalmesh2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1923 {
1924 GLenum mode;
1925 int i1, i2;
1926 int j1, j2;
1927
1928 if (objc < 6) goto ERROR;
1929 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
1930 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &i1), ERROR);
1931 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &i2), ERROR);
1932 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &j1), ERROR);
1933 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[5], &j2), ERROR);
1934 GL_CHECK(glEvalMesh2 (mode, i1, i2, j1, j2));
1935 return 6;
1936
1937 ERROR:
1938 Tcl_SetObjResult (interp, objv[0]);
1939 Tcl_AppendResult (interp, ": wrong # args. should mode i1 i2 j1 j2.", NULL);
1940 return 0;
1941 }
1942
1943 static int
gl_subcmd_flush(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1944 gl_subcmd_flush (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1945 {
1946 GL_CHECK(glFlush ());
1947 return 1;
1948 }
1949
1950 static int
gl_subcmd_fog(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1951 gl_subcmd_fog (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
1952 {
1953 GLenum pname;
1954 double fparam;
1955 GLfloat c[4];
1956 int iparam;
1957
1958 if (objc < 3) goto ERROR;
1959 ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
1960 switch (pname) {
1961 case GL_FOG_MODE:
1962 ENUM_CHECK((iparam = GetGLEnum (objv[2])), ERROR);
1963 glFogi (pname, iparam);
1964 return 3;
1965
1966 case GL_FOG_DENSITY:
1967 case GL_FOG_START:
1968 case GL_FOG_END:
1969 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &fparam), ERROR);
1970 glFogf (pname, fparam);
1971 return 3;
1972
1973 case GL_FOG_COLOR:
1974 if (objc < 6) goto ERROR;
1975 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &fparam), ERROR);
1976 c[0] = fparam;
1977 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &fparam), ERROR);
1978 c[1] = fparam;
1979 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &fparam), ERROR);
1980 c[2] = fparam;
1981 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &fparam), ERROR);
1982 c[3] = fparam;
1983 GL_CHECK(glFogfv (pname, c));
1984 return 6;
1985
1986 default:
1987 Tcl_SetObjResult (interp, objv[0]);
1988 Tcl_AppendResult (interp, ": wrong parameter name.", NULL);
1989 return 0;
1990 }
1991
1992 ERROR:
1993 Tcl_SetObjResult (interp, objv[0]);
1994 Tcl_AppendResult (interp, ": wrong # args. should mode i1 i2 j1 j2.", NULL);
1995 return 0;
1996 }
1997
1998 static int
gl_subcmd_frontface(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])1999 gl_subcmd_frontface (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2000 {
2001 GLenum mode;
2002
2003 if (objc < 2) goto ERROR;
2004 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
2005 GL_CHECK(glFrontFace (mode));
2006 return 2;
2007
2008 ERROR:
2009 Tcl_SetObjResult (interp, objv[0]);
2010 Tcl_AppendResult (interp, ": wrong # args. should flag.", NULL);
2011 return 0;
2012 }
2013
2014 static int
gl_subcmd_gentextures(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2015 gl_subcmd_gentextures (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2016 {
2017 int num = 1;
2018 GLuint *names;
2019 Tcl_Obj *val;
2020 int i;
2021 int nargs = 1;
2022
2023 if (objc < 2) goto ERROR;
2024
2025 if (objc >= 3 && Tcl_GetIntFromObj (interp, objv[2], &num) != TCL_ERROR) {
2026 nargs = 2;
2027 }
2028 names = gr_new (GLuint, num);
2029
2030 GL_CHECK(glGenTextures (num, names));
2031
2032 if (num == 1) {
2033 val = Tcl_NewIntObj (names[0]);
2034 Tcl_ObjSetVar2 (interp, objv[1], NULL, val, 0);
2035 } else {
2036 val = Tcl_NewListObj (0, NULL);
2037 for (i=0; i<num; i++) {
2038 Tcl_ListObjAppendElement (interp, val, Tcl_NewIntObj (names[i]));
2039 }
2040 Tcl_ObjSetVar2 (interp, objv[1], NULL, val, 0);
2041 }
2042 return nargs + 1;
2043
2044 ERROR:
2045 Tcl_SetObjResult (interp, objv[0]);
2046 Tcl_AppendResult (interp, ": wrong # args. should flag.", NULL);
2047 return 0;
2048 }
2049
2050 static int
gl_subcmd_hint(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2051 gl_subcmd_hint (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2052 {
2053 GLenum target;
2054 GLenum mode;
2055
2056 if (objc < 3) goto ERROR;
2057 ENUM_CHECK((target = GetGLEnum (objv[1])), ERROR);
2058 ENUM_CHECK((mode = GetGLEnum (objv[2])), ERROR);
2059 GL_CHECK(glHint (target, mode));
2060 return 3;
2061
2062 ERROR:
2063 OBJ_RESULT (objv[0], ": wrong # args. should flag.");
2064 return 0;
2065 }
2066
2067 static int
gl_subcmd_initnames(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2068 gl_subcmd_initnames (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2069 {
2070 GL_CHECK(glInitNames ());
2071 return 1;
2072 }
2073
2074 static int
gl_subcmd_light(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2075 gl_subcmd_light (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2076 {
2077 GLfloat f[4];
2078 double d;
2079 GLenum light;
2080 GLenum pname;
2081 int i, num;
2082
2083 if (objc < 3) goto ERROR;
2084 ENUM_CHECK((light = GetGLEnum (objv[1])), ERROR);
2085 ENUM_CHECK((pname = GetGLEnum (objv[2])), ERROR);
2086 switch (pname) {
2087 case GL_AMBIENT:
2088 case GL_DIFFUSE:
2089 case GL_SPECULAR:
2090 case GL_POSITION:
2091 num = 4;
2092 break;
2093
2094 case GL_SPOT_DIRECTION:
2095 num = 3;
2096 break;
2097
2098 case GL_SPOT_EXPONENT:
2099 case GL_SPOT_CUTOFF:
2100 case GL_CONSTANT_ATTENUATION:
2101 case GL_LINEAR_ATTENUATION:
2102 case GL_QUADRATIC_ATTENUATION:
2103 num = 1;
2104 break;
2105
2106 default:
2107 goto ERROR;
2108 }
2109 if (objc < 3 + num) goto ERROR;
2110
2111 for (i=0; i<num; i++) {
2112 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3+i], &d), ERROR);
2113 f[i] = d;
2114 }
2115 GL_CHECK(glLightfv (light, pname, f));
2116 return num + 3;
2117
2118 ERROR:
2119 OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
2120 return 0;
2121 }
2122
2123 static int
gl_subcmd_lightmodel(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2124 gl_subcmd_lightmodel (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2125 {
2126 GLfloat f[4];
2127 double d;
2128 int i;
2129 GLenum pname;
2130
2131 if (objc < 3) goto ERROR;
2132 ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
2133 switch (pname) {
2134 case GL_LIGHT_MODEL_AMBIENT:
2135 if (objc < 5) goto ERROR;
2136 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &d), ERROR);
2137 f[0] = d;
2138 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &d), ERROR);
2139 f[1] = d;
2140 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], &d), ERROR);
2141 f[2] = d;
2142 GL_CHECK(glLightModelfv (pname, f));
2143 return 6;
2144
2145 case GL_LIGHT_MODEL_LOCAL_VIEWER:
2146 case GL_LIGHT_MODEL_TWO_SIDE:
2147 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &i), ERROR);
2148 GL_CHECK(glLightModeli (pname, i));
2149 return 3;
2150 }
2151
2152 ERROR:
2153 OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
2154 return 0;
2155 }
2156
2157 static int
gl_subcmd_loadmatrix(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2158 gl_subcmd_loadmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2159 {
2160 GLdouble m[16];
2161 int i, j;
2162
2163 if (objc < 17) goto ERROR;
2164 for (i=0; i<4; i++) {
2165 for (j=0; j<4; j++) {
2166 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[i*4+j+1], &m[i+j*4]), ERROR);
2167 }
2168 }
2169 GL_CHECK(glLoadMatrixd (m));
2170 return 17;
2171
2172 ERROR:
2173 OBJ_RESULT (objv[0], ": wrong # args. m[0][0] m[0][1] ...");
2174 return 0;
2175 }
2176
2177 static int
gl_subcmd_lookat(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2178 gl_subcmd_lookat (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2179 {
2180 GLdouble eyex, eyey, eyez;
2181 GLdouble centerx, centery, centerz;
2182 GLdouble upx, upy, upz;
2183
2184 if (objc < 10) goto ERROR;
2185 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &eyex), ERROR);
2186 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &eyey), ERROR);
2187 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &eyez), ERROR);
2188 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], ¢erx), ERROR);
2189 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[5], ¢ery), ERROR);
2190 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[6], ¢erz), ERROR);
2191 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[7], &upx), ERROR);
2192 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[8], &upy), ERROR);
2193 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[9], &upz), ERROR);
2194
2195 GL_CHECK(gluLookAt (eyex, eyey, eyez,
2196 centerx, centery, centerz,
2197 upx, upy, upz));
2198 return 10;
2199
2200 ERROR:
2201 OBJ_RESULT (objv[0], ": wrong # args. eye[xyz] center[xyz] up[xyz].");
2202 return 0;
2203 }
2204
2205 static int
gl_subcmd_linestipple(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2206 gl_subcmd_linestipple (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2207 {
2208 int factor;
2209 int pattern;
2210
2211 if (objc < 3) goto ERROR;
2212 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &factor), ERROR);
2213 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &pattern), ERROR);
2214 GL_CHECK(glLineStipple (factor, pattern));
2215 return 3;
2216
2217 ERROR:
2218 OBJ_RESULT (objv[0], ": wrong # args. should factor pattern.");
2219 return 0;
2220 }
2221
2222 static int
gl_subcmd_linewidth(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2223 gl_subcmd_linewidth (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2224 {
2225 double width;
2226
2227 if (objc < 2) goto ERROR;
2228 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &width), ERROR);
2229 GL_CHECK(glLineWidth (width));
2230 return 2;
2231
2232 ERROR:
2233 OBJ_RESULT (objv[0], ": wrong # args. should width.");
2234 return 0;
2235 }
2236
2237 static int
gl_subcmd_loadname(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2238 gl_subcmd_loadname (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2239 {
2240 int name;
2241
2242 if (objc < 2) goto ERROR;
2243 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &name), ERROR);
2244 GL_CHECK(glLoadName (name));
2245 return 2;
2246
2247 ERROR:
2248 OBJ_RESULT (objv[0], ": wrong # args. should name.");
2249 return 0;
2250 }
2251
2252 static int
gl_subcmd_map1(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2253 gl_subcmd_map1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2254 {
2255 GLenum target;
2256 double u1, u2;
2257 int stride, order;
2258 double *p;
2259 int i, total;
2260
2261 if (objc < 6) goto ERROR;
2262 ENUM_CHECK ((target = GetGLEnum (objv[1])), ERROR);
2263 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
2264 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
2265 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &stride), ERROR);
2266 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[5], &order), ERROR);
2267
2268 total = stride * order;
2269 p = gr_new (GLdouble, total);
2270 if (!p)
2271 goto ERROR;
2272
2273 for (i=0; i<total; i++) {
2274 p[i] = DoubleFromList (interp, objv[6], i);
2275 }
2276 GL_CHECK(glMap1d (target, u1, u2, stride, order, p));
2277 free (p);
2278 return 7;
2279
2280 ERROR:
2281 OBJ_RESULT (objv[0], ": wrong # args. should target u1 u2 stride order "
2282 "{point ... }");
2283 return 0;
2284 }
2285
2286 static int
gl_subcmd_map2(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2287 gl_subcmd_map2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2288 {
2289 GLenum target;
2290 double u1, u2;
2291 double v1, v2;
2292 int ustride, uorder;
2293 int vstride, vorder;
2294 double *p;
2295 int i, total;
2296
2297 if (objc < 10) goto ERROR;
2298 ENUM_CHECK ((target = GetGLEnum (objv[1])), ERROR);
2299 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
2300 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
2301 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &ustride), ERROR);
2302 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[5], &uorder), ERROR);
2303 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &v1), ERROR);
2304 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[7], &v2), ERROR);
2305 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[8], &vstride), ERROR);
2306 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[9], &vorder), ERROR);
2307
2308 total = ustride * uorder * vorder;
2309 if (objc < 10 + total) goto ERROR;
2310
2311 p = gr_new (GLdouble, total);
2312 if (!p)
2313 goto ERROR;
2314
2315 for (i=0; i<total; i++) {
2316 p[i] = DoubleFromList (interp, objv[8], i);
2317 }
2318 GL_CHECK(glMap2d (target,
2319 u1, u2, ustride, uorder,
2320 v1, v2, vstride, vorder, p));
2321 free (p);
2322 return 11;
2323
2324 ERROR:
2325 OBJ_RESULT (objv[0], ": wrong # args. should target u1 u2 "
2326 "ustride uorder v1 v2 vstride vorder {point ... }");
2327 return 0;
2328 }
2329
2330 static int
gl_subcmd_mapgrid1(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2331 gl_subcmd_mapgrid1 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2332 {
2333 int n;
2334 double u1, u2;
2335
2336 if (objc < 4) goto ERROR;
2337 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &n), ERROR);
2338 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
2339 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
2340
2341 GL_CHECK(glMapGrid1d (n, u1, u2));
2342 return 4;
2343
2344 ERROR:
2345 OBJ_RESULT (objv[0], ": wrong # args. n u1 u2.");
2346 return 0;
2347 }
2348
2349 static int
gl_subcmd_mapgrid2(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2350 gl_subcmd_mapgrid2 (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2351 {
2352 int nu, nv;
2353 double u1, u2;
2354 double v1, v2;
2355
2356 if (objc < 7) goto ERROR;
2357 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &nu), ERROR);
2358 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &u1), ERROR);
2359 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &u2), ERROR);
2360 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &nv), ERROR);
2361 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[5], &v1), ERROR);
2362 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[6], &v2), ERROR);
2363
2364 GL_CHECK(glMapGrid2d (nu, u1, u2, nv, v1, v2));
2365 return 7;
2366
2367 ERROR:
2368 OBJ_RESULT (objv[0], ": wrong # args. nu u1 u2 nv v1 v2.");
2369 return 0;
2370 }
2371
2372 static int
gl_subcmd_material(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2373 gl_subcmd_material (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2374 {
2375 GLenum face, pname;
2376 int i, num;
2377 GLfloat p[4];
2378 double d;
2379
2380 if (objc < 4) goto ERROR;
2381 ENUM_CHECK ((face = GetGLEnum (objv[1])), ERROR);
2382 ENUM_CHECK ((pname = GetGLEnum (objv[2])), ERROR);
2383 switch (pname) {
2384 case GL_AMBIENT:
2385 case GL_DIFFUSE:
2386 case GL_AMBIENT_AND_DIFFUSE:
2387 case GL_SPECULAR:
2388 case GL_EMISSION:
2389 if (objc < 7) goto ERROR;
2390 num = 4;
2391 break;
2392
2393 case GL_SHININESS:
2394 num = 1;
2395 break;
2396
2397 default:
2398 goto ERROR;
2399 }
2400
2401 for (i=0; i<num; i++) {
2402 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3+i], &d), ERROR);
2403 p[i] = d;
2404 }
2405
2406 GL_CHECK(glMaterialfv (face, pname, p));
2407 return 3 + num;
2408
2409 ERROR:
2410 OBJ_RESULT (objv[0], ": wrong # args. should face pname param ...");
2411 return 0;
2412 }
2413
2414 static int
gl_subcmd_multmatrix(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2415 gl_subcmd_multmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2416 {
2417 GLdouble m[16];
2418 int i, j;
2419
2420 if (objc < 17) goto ERROR;
2421 for (i=0; i<4; i++) {
2422 for (j=0; j<4; j++) {
2423 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[i*4+j+1], &m[i+j*4]), ERROR);
2424 }
2425 }
2426 GL_CHECK(glMultMatrixd (m));
2427 return 17;
2428
2429 ERROR:
2430 OBJ_RESULT (objv[0], ": wrong # args. m[0][0] m[0][1] ...");
2431 return 0;
2432 }
2433
2434 static int
gl_subcmd_perspective(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2435 gl_subcmd_perspective (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2436 {
2437 double fov, aspect, near, far;
2438
2439 if (objc < 5) goto ERROR;
2440 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &fov), ERROR);
2441 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &aspect), ERROR);
2442 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &near), ERROR);
2443 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], &far), ERROR);
2444
2445 GL_CHECK(gluPerspective (fov, aspect, near, far));
2446 return 5;
2447
2448 ERROR:
2449 OBJ_RESULT (objv[0], ": wrong # args. should fovy aspect near far.");
2450 return 0;
2451 }
2452
2453 static int
gl_subcmd_pickmatrix(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2454 gl_subcmd_pickmatrix (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2455 {
2456 double x, y, width, height;
2457 int viewport[4];
2458
2459 if (objc < 9) goto ERROR;
2460 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &x), ERROR);
2461 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &y), ERROR);
2462 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3], &width), ERROR);
2463 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[4], &height), ERROR);
2464 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[5], &viewport[0]), ERROR);
2465 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[6], &viewport[1]), ERROR);
2466 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[7], &viewport[2]), ERROR);
2467 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[8], &viewport[3]), ERROR);
2468
2469 GL_CHECK(gluPickMatrix (x, y, width, height, viewport));
2470 return 9;
2471
2472 ERROR:
2473 OBJ_RESULT (objv[0], ": wrong # args. should x y w h v0 v1 v2 v3.");
2474 return 0;
2475 }
2476
2477 static int
gl_subcmd_pixeltransfer(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2478 gl_subcmd_pixeltransfer (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2479 {
2480 GLenum pname;
2481 double param;
2482
2483 if (objc < 3) goto ERROR;
2484 ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
2485 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], ¶m), ERROR);
2486
2487 GL_CHECK(glPixelTransferf (pname, param));
2488 return 3;
2489
2490 ERROR:
2491 OBJ_RESULT (objv[0], ": wrong # args. should pname param.");
2492 return 0;
2493 }
2494
2495 static int
gl_subcmd_pixelzoom(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2496 gl_subcmd_pixelzoom (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2497 {
2498 double xf, yf;
2499
2500 if (objc < 3) goto ERROR;
2501 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &xf), ERROR);
2502 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2], &yf), ERROR);
2503
2504 GL_CHECK(glPixelZoom (xf, yf));
2505 return 3;
2506
2507 ERROR:
2508 OBJ_RESULT (objv[0], ": wrong # args. should xfactor yfactor.");
2509 return 0;
2510 }
2511
2512 static int
gl_subcmd_polygonmode(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2513 gl_subcmd_polygonmode (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2514 {
2515 GLenum face, mode;
2516
2517 if (objc < 3) goto ERROR;
2518 ENUM_CHECK((face = GetGLEnum (objv[1])), ERROR);
2519 ENUM_CHECK((mode = GetGLEnum (objv[2])), ERROR);
2520 GL_CHECK(glPolygonMode (face, mode));
2521 return 3;
2522
2523 ERROR:
2524 OBJ_RESULT (objv[0], ": wrong # args. should face mode.");
2525 return 0;
2526 }
2527
2528 static int
gl_subcmd_pointsize(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2529 gl_subcmd_pointsize (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2530 {
2531 double size;
2532
2533 if (objc < 2) goto ERROR;
2534 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &size), ERROR);
2535 GL_CHECK(glPointSize (size));
2536 return 2;
2537
2538 ERROR:
2539 OBJ_RESULT (objv[0], ": wrong # args. should size.");
2540 return 0;
2541 }
2542
2543 static int
gl_subcmd_popattrib(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2544 gl_subcmd_popattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2545 {
2546 GL_CHECK(glPopAttrib ());
2547 return 1;
2548 }
2549
2550 static int
gl_subcmd_popclientattrib(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2551 gl_subcmd_popclientattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2552 {
2553 GL_CHECK(glPopClientAttrib ());
2554 return 1;
2555 }
2556
2557 static int
gl_subcmd_popname(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2558 gl_subcmd_popname (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2559 {
2560 GL_CHECK(glPopName ());
2561 return 1;
2562 }
2563
2564 static int
gl_subcmd_pushattrib(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2565 gl_subcmd_pushattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2566 {
2567 GLbitfield mask = 0, res;
2568 int i;
2569 char *str;
2570
2571 if (objc < 2) {
2572 OBJ_RESULT (objv[0], ": wrong # args. mask [mask ...].");
2573 return 0;
2574 }
2575
2576 for (i=1; i<objc; i++) {
2577 str = Tcl_GetStringFromObj (objv[i], NULL);
2578 if (str && str[0] == '-')
2579 break;
2580 ENUM_CHECK((res = GetGLEnum (objv[i])), ERROR);
2581 mask |= (GLbitfield) res;
2582 }
2583
2584 GL_CHECK(glPushAttrib (mask));
2585 return i;
2586
2587 ERROR:
2588 Tcl_SetObjResult (interp, objv[0]);
2589 Tcl_AppendResult (interp, ": unkown attrib \"", str, "\".", NULL);
2590 return 0;
2591 }
2592
2593 static int
gl_subcmd_pushclientattrib(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2594 gl_subcmd_pushclientattrib (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2595 {
2596 GLbitfield mask = 0, res;
2597 int i;
2598 char *str;
2599
2600 if (objc < 2) {
2601 OBJ_RESULT (objv[0], ": wrong # args. mask [mask ...].");
2602 return 0;
2603 }
2604
2605 for (i=1; i<objc; i++) {
2606 str = Tcl_GetStringFromObj (objv[i], NULL);
2607 if (str && str[0] == '-')
2608 break;
2609 ENUM_CHECK((res = GetGLEnum (objv[i])), ERROR);
2610 mask |= (GLbitfield) res;
2611 }
2612
2613 GL_CHECK(glPushClientAttrib (mask));
2614 return i;
2615
2616 ERROR:
2617 Tcl_SetObjResult (interp, objv[0]);
2618 Tcl_AppendResult (interp, ": unkown attrib \"", str, "\".", NULL);
2619 return 0;
2620 }
2621
2622 static int
gl_subcmd_pushname(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2623 gl_subcmd_pushname (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2624 {
2625 int name;
2626
2627 if (objc < 2) goto ERROR;
2628 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &name), ERROR);
2629 GL_CHECK(glPushName (name));
2630 return 2;
2631
2632 ERROR:
2633 OBJ_RESULT (objv[0], ": wrong # args. should name.");
2634 return 0;
2635 }
2636
2637 static int
gl_subcmd_rasterpos(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2638 gl_subcmd_rasterpos (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2639 {
2640 double c[4];
2641
2642 if (objc < 3) goto ERROR;
2643 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &c[0]), ERROR);
2644 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &c[1]), ERROR);
2645 if (objc < 4 || Tcl_GetDoubleFromObj (interp, objv[3], &c[2]) == TCL_ERROR) {
2646 GL_CHECK(glRasterPos2dv (c));
2647 return 3;
2648 } else
2649 if (objc < 5 || Tcl_GetDoubleFromObj (interp, objv[4], &c[3]) == TCL_ERROR) {
2650 GL_CHECK(glRasterPos3dv (c));
2651 return 4;
2652 } else {
2653 GL_CHECK(glRasterPos4dv (c));
2654 return 4;
2655 }
2656
2657 ERROR:
2658 OBJ_RESULT (objv[0], ": wrong # args. x y [z [w]].");
2659 return 0;
2660 }
2661
2662 #if 0
2663 static int
2664 gl_subcmd_readpixels (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2665 {
2666 char *name;
2667 int x, y;
2668 Tk_PhotoHandle handle;
2669 Tk_PhotoImageBlock block;
2670
2671 if (objc < 4) goto ERROR;
2672 name = Tcl_GetStringFromObj (objv[1], NULL);
2673 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &x), ERROR);
2674 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &y), ERROR);
2675
2676 handle = Tk_FindPhoto (interp, name);
2677 if (!handle) {
2678 OBJ_RESULT (objv[0], ": photo not defined.", name, NULL);
2679 return 0;
2680 }
2681 if (Tk_PhotoGetImage (handle, &block) != 1) {
2682 OBJ_RESULT (objv[0], ": couldn't get photo image.");
2683 return 0;
2684 }
2685 if (block.pixelSize != 3 && block.pixelSize != 4) {
2686 OBJ_RESULT (objv[0], ": image has invalid pixel size.");
2687 return 0;
2688 }
2689 switch (block.pitch - block.width * block.pixelSize) {
2690 case 0:
2691 GL_CHECK(glPixelStorei (GL_PACK_ALIGNMENT, 1));
2692 break;
2693
2694 case 1:
2695 GL_CHECK(glPixelStorei (GL_PACK_ALIGNMENT, 2));
2696 break;
2697
2698 case 2:
2699 case 3:
2700 GL_CHECK(glPixelStorei (GL_PACK_ALIGNMENT, 4));
2701 break;
2702
2703 default:
2704 OBJ_RESULT (objv[0], ": unknown alignment.");
2705 return 0;
2706 }
2707
2708 GL_CHECK(glReadPixels (x, y, block.width, block.height,
2709 block.pixelSize == 3? GL_RGB : GL_RGBA,
2710 GL_UNSIGNED_BYTE, block.pixelPtr));
2711 return 4;
2712
2713 ERROR:
2714 OBJ_RESULT (objv[0], ": wrong # args. image x y.");
2715 return 0;
2716 }
2717 #endif
2718
2719 static int
gl_subcmd_readbuffer(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2720 gl_subcmd_readbuffer (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2721 {
2722 GLenum mode;
2723
2724 if (objc < 2) goto ERROR;
2725 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
2726 GL_CHECK(glReadBuffer (mode));
2727 return 2;
2728
2729 ERROR:
2730 OBJ_RESULT (objv[0], ": wrong # args. should mode.");
2731 return 0;
2732 }
2733
2734 static int
gl_subcmd_rect(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2735 gl_subcmd_rect (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2736 {
2737 double x1, y1, x2, y2;
2738
2739 if (objc < 5) goto ERROR;
2740 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[1], &x1), ERROR);
2741 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[2], &y1), ERROR);
2742 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &x2), ERROR);
2743 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[4], &y2), ERROR);
2744 GL_CHECK(glRectd (x1, y1, x2, y2));
2745 return 5;
2746
2747 ERROR:
2748 OBJ_RESULT (objv[0], ": wrong # args. should x1 y1 x2 y2.");
2749 return 0;
2750 }
2751
2752 static int
gl_subcmd_scissor(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2753 gl_subcmd_scissor (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2754 {
2755 int x, y, w, h;
2756
2757 if (objc < 5) goto ERROR;
2758 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &x), ERROR);
2759 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &y), ERROR);
2760 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &w), ERROR);
2761 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[4], &h), ERROR);
2762 GL_CHECK(glScissor (x, y, w, h));
2763 return 5;
2764
2765 ERROR:
2766 OBJ_RESULT (objv[0], ": wrong # args. should x y w h.");
2767 return 0;
2768 }
2769
2770 static int
gl_subcmd_shademodel(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2771 gl_subcmd_shademodel (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2772 {
2773 GLenum mode;
2774
2775 if (objc < 2) goto ERROR;
2776 ENUM_CHECK((mode = GetGLEnum (objv[1])), ERROR);
2777 GL_CHECK(glShadeModel (mode));
2778 return 2;
2779
2780 ERROR:
2781 OBJ_RESULT (objv[0], ": wrong # args. should mode.");
2782 return 0;
2783 }
2784
2785 static int
gl_subcmd_stencilfunc(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2786 gl_subcmd_stencilfunc (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2787 {
2788 GLenum func;
2789 int ref, mask;
2790
2791 if (objc < 4) goto ERROR;
2792 ENUM_CHECK((func = GetGLEnum (objv[1])), ERROR);
2793 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[2], &ref), ERROR);
2794 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[3], &mask), ERROR);
2795 GL_CHECK(glStencilFunc(func, ref, mask));
2796 return 4;
2797
2798 ERROR:
2799 OBJ_RESULT (objv[0], ": wrong # args. should func ref mask.");
2800 return 0;
2801 }
2802
2803 static int
gl_subcmd_stencilmask(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2804 gl_subcmd_stencilmask (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2805 {
2806 int mask;
2807
2808 if (objc < 2) goto ERROR;
2809 TCL_CHECK(Tcl_GetIntFromObj(interp, objv[1], &mask), ERROR);
2810 GL_CHECK(glStencilMask(mask));
2811 return 2;
2812
2813 ERROR:
2814 OBJ_RESULT (objv[0], ": wrong # args. should mask.");
2815 return 0;
2816 }
2817
2818 static int
gl_subcmd_stencilop(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2819 gl_subcmd_stencilop (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2820 {
2821 GLenum fail, zfail, zpass;
2822
2823 if (objc < 4) goto ERROR;
2824 ENUM_CHECK((fail = GetGLEnum (objv[1])), ERROR);
2825 ENUM_CHECK((zfail = GetGLEnum (objv[2])), ERROR);
2826 ENUM_CHECK((zpass = GetGLEnum (objv[3])), ERROR);
2827 GL_CHECK(glStencilOp(fail, zfail, zpass));
2828 return 4;
2829
2830 ERROR:
2831 OBJ_RESULT (objv[0], ": wrong # args. should fail zfail zpass.");
2832 return 0;
2833 }
2834
2835 static int
gl_subcmd_texcoord(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2836 gl_subcmd_texcoord (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2837 {
2838 double v[4];
2839
2840 if (objc < 2) goto ERROR;
2841 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[1], &v[0]), ERROR);
2842 if (objc < 3 || Tcl_GetDoubleFromObj(interp, objv[2], &v[1]) == TCL_ERROR) {
2843 GL_CHECK(glTexCoord1dv (v));
2844 return 2;
2845 }
2846 if (objc < 4 || Tcl_GetDoubleFromObj(interp, objv[3], &v[2]) == TCL_ERROR) {
2847 GL_CHECK(glTexCoord2dv (v));
2848 return 3;
2849 }
2850 if (objc < 5 || Tcl_GetDoubleFromObj(interp, objv[4], &v[3]) == TCL_ERROR) {
2851 GL_CHECK(glTexCoord3dv (v));
2852 return 4;
2853 }
2854 GL_CHECK(glTexCoord4dv (v));
2855 return 5;
2856
2857 ERROR:
2858 OBJ_RESULT (objv[0], ": wrong # args. should s [t [r [q]]].");
2859 return 0;
2860 }
2861
2862 static int
gl_subcmd_texenv(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2863 gl_subcmd_texenv (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2864 {
2865 GLenum pname;
2866 GLenum eparam;
2867 float param[4];
2868 double d;
2869 int i;
2870
2871 if (objc < 3) goto ERROR;
2872 ENUM_CHECK((pname = GetGLEnum (objv[1])), ERROR);
2873 switch (pname) {
2874 case GL_TEXTURE_ENV_MODE:
2875 ENUM_CHECK((eparam = GetGLEnum (objv[2])), ERROR);
2876 GL_CHECK(glTexEnvi (GL_TEXTURE_ENV, pname, eparam));
2877 return 3;
2878
2879 case GL_TEXTURE_ENV_COLOR:
2880 if (objc < 6) goto ERROR;
2881 for (i=0; i<4; i++) {
2882 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[2+i], &d), ERROR);
2883 param[i] = d;
2884 }
2885 GL_CHECK(glTexEnvfv (GL_TEXTURE_ENV, pname, param));
2886 return 6;
2887 }
2888
2889 ERROR:
2890 OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
2891 return 0;
2892 }
2893
2894 static int
gl_subcmd_texgen(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])2895 gl_subcmd_texgen (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2896 {
2897 GLenum coord;
2898 GLenum pname;
2899 GLenum eparam;
2900 float param[4];
2901 double d;
2902 int i;
2903
2904 if (objc < 4) goto ERROR;
2905 ENUM_CHECK((coord = GetGLEnum (objv[1])), ERROR);
2906 ENUM_CHECK((pname = GetGLEnum (objv[2])), ERROR);
2907 switch (pname) {
2908 case GL_TEXTURE_GEN_MODE:
2909 ENUM_CHECK((eparam = GetGLEnum (objv[3])), ERROR);
2910 GL_CHECK(glTexGeni (coord, pname, eparam));
2911 return 4;
2912
2913 default:
2914 if (objc < 7) goto ERROR;
2915 for (i=0; i<4; i++) {
2916 TCL_CHECK(Tcl_GetDoubleFromObj(interp, objv[3+i], &d), ERROR);
2917 param[i] = d;
2918 }
2919 GL_CHECK(glTexGenfv (coord, pname, param));
2920 return 7;
2921 }
2922
2923 ERROR:
2924 OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
2925 return 0;
2926 }
2927
2928 #if 0
2929 static int
2930 gl_subcmd_teximage1d (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2931 {
2932 int level;
2933 int border;
2934 Tk_PhotoHandle handle;
2935 Tk_PhotoImageBlock block;
2936 char *name;
2937 int i, n;
2938
2939 if (objc < 4) goto ERROR;
2940 name = Tcl_GetStringFromObj (objv[1], NULL);
2941 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &level), ERROR);
2942 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &border), ERROR);
2943
2944 handle = Tk_FindPhoto (interp, name);
2945 if (!handle) {
2946 Tcl_SetObjResult (interp, objv[0]);
2947 Tcl_AppendResult (interp, ": photo not defined \"", name, "\".", NULL);
2948 return 0;
2949 }
2950 if (Tk_PhotoGetImage (handle, &block) != 1) {
2951 OBJ_RESULT (objv[0], ": couldn't get photo image.");
2952 return 0;
2953 }
2954 if (block.pixelSize != 3 && block.pixelSize != 4) {
2955 OBJ_RESULT (objv[0], ": image has invalid pixel size.");
2956 return 0;
2957 }
2958 n = block.width - border;
2959 for (i=0; i<16; i++) {
2960 if (n == (1<<i))
2961 break;
2962 }
2963 if (i == 16) {
2964 OBJ_RESULT (objv[0], ": image width must be a power of 2.");
2965 return 0;
2966 }
2967
2968 GL_CHECK(glPixelStorei (GL_UNPACK_ALIGNMENT, 1));
2969 GL_CHECK(glTexImage1D (GL_TEXTURE_1D, level, block.pixelSize,
2970 block.width, border,
2971 block.pixelSize == 3 ? GL_RGB : GL_RGBA,
2972 GL_UNSIGNED_BYTE, block.pixelPtr));
2973 return 4;
2974
2975 ERROR:
2976 OBJ_RESULT (objv[0], ": wrong # args. image level border.");
2977 return 0;
2978 }
2979
2980 static int
2981 gl_subcmd_teximage2d (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
2982 {
2983 int level;
2984 int border;
2985 Tk_PhotoHandle handle;
2986 Tk_PhotoImageBlock block;
2987 char *name;
2988 int i, n;
2989
2990 if (objc < 4) goto ERROR;
2991 name = Tcl_GetStringFromObj (objv[1], NULL);
2992 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &level), ERROR);
2993 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[3], &border), ERROR);
2994
2995 handle = Tk_FindPhoto (interp, name);
2996 if (!handle) {
2997 Tcl_SetObjResult (interp, objv[0]);
2998 Tcl_AppendResult (interp, ": photo not defined \"", name, "\".", NULL);
2999 return 0;
3000 }
3001 if (Tk_PhotoGetImage (handle, &block) != 1) {
3002 OBJ_RESULT (objv[0], ": couldn't get photo image.");
3003 return 0;
3004 }
3005 if (block.pixelSize != 3 && block.pixelSize != 4) {
3006 OBJ_RESULT (objv[0], ": image has invalid pixel size.");
3007 return 0;
3008 }
3009 n = block.width - border;
3010 for (i=0; i<16; i++) {
3011 if (n == (1<<i))
3012 break;
3013 }
3014 if (i == 16) {
3015 OBJ_RESULT (objv[0], ": image width must be a power of 2.");
3016 return 0;
3017 }
3018 n = block.height - border;
3019 for (i=0; i<16; i++) {
3020 if (n == (1<<i))
3021 break;
3022 }
3023 if (i == 16) {
3024 OBJ_RESULT (objv[0], ": image height must be a power of 2.");
3025 return 0;
3026 }
3027
3028 GL_CHECK(glPixelStorei (GL_UNPACK_ALIGNMENT, 1));
3029 GL_CHECK(glTexImage2D (GL_TEXTURE_2D, level, block.pixelSize,
3030 block.width, block.height, border,
3031 block.pixelSize == 3 ? GL_RGB : GL_RGBA,
3032 GL_UNSIGNED_BYTE, block.pixelPtr));
3033 return 4;
3034
3035 ERROR:
3036 OBJ_RESULT (objv[0], ": wrong # args. image level border.");
3037 return 0;
3038 }
3039 #endif
3040
3041 static int
gl_subcmd_texparameter(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3042 gl_subcmd_texparameter (Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
3043 {
3044 GLenum target;
3045 GLenum pname;
3046 GLenum eparam;
3047 float param[4];
3048 double d;
3049 int i;
3050
3051 if (objc < 4) goto ERROR;
3052 ENUM_CHECK((target = GetGLEnum (objv[1])), ERROR);
3053 ENUM_CHECK((pname = GetGLEnum (objv[2])), ERROR);
3054 switch (pname) {
3055 case GL_TEXTURE_WRAP_S:
3056 case GL_TEXTURE_WRAP_T:
3057 case GL_TEXTURE_MAG_FILTER:
3058 case GL_TEXTURE_MIN_FILTER:
3059 ENUM_CHECK((eparam = GetGLEnum (objv[3])), ERROR);
3060 GL_CHECK(glTexParameteri (target, pname, eparam));
3061 return 4;
3062
3063 case GL_TEXTURE_BORDER_COLOR:
3064 if (objc < 7) goto ERROR;
3065 for (i=0; i<4; i++) {
3066 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3+i], &d), ERROR);
3067 param[i] = d;
3068 }
3069 GL_CHECK(glTexParameterfv (target, pname, param));
3070 return 7;
3071
3072 case GL_TEXTURE_PRIORITY:
3073 TCL_CHECK(Tcl_GetDoubleFromObj (interp, objv[3], &d), ERROR);
3074 param[0] = d;
3075 GL_CHECK(glTexParameterf (target, pname, param[0]));
3076 return 4;
3077 }
3078
3079 ERROR:
3080 OBJ_RESULT (objv[0], ": wrong # args. check OpenGL manual.");
3081 return 0;
3082 }
3083
3084 static GrFunctionList glfunclist[] = {
3085 {"accum", gl_subcmd_accum},
3086 {"alphafunc", gl_subcmd_alphafunc},
3087 {"begin", gl_subcmd_begin},
3088 {"bindtexture", gl_subcmd_bindtexture},
3089 {"blendfunc", gl_subcmd_blendfunc},
3090 {"calllist", gl_subcmd_calllist},
3091 {"clear", gl_subcmd_clear},
3092 {"clearaccum", gl_subcmd_clearaccum},
3093 {"clearcolor", gl_subcmd_clearcolor},
3094 {"cleardepth", gl_subcmd_cleardepth},
3095 {"clearstencil", gl_subcmd_clearstencil},
3096 {"copypixels", gl_subcmd_copypixels},
3097 {"clipplane", gl_subcmd_clipplane},
3098 {"color", gl_subcmd_color},
3099 {"colormask", gl_subcmd_colormask},
3100 {"colormaterial", gl_subcmd_colormaterial},
3101 {"cullface", gl_subcmd_cullface},
3102 {"deletelists", gl_subcmd_deletelists},
3103 {"deletetextures", gl_subcmd_deletetextures},
3104 {"depthfunc", gl_subcmd_depthfunc},
3105 {"depthmask", gl_subcmd_depthmask},
3106 {"disable", gl_subcmd_disable},
3107 {"drawbuffer", gl_subcmd_drawbuffer},
3108 #if 0
3109 {"drawpixels", gl_subcmd_drawpixels},
3110 #endif
3111 {"edgeflag", gl_subcmd_edgeflag},
3112 {"enable", gl_subcmd_enable},
3113 {"end", gl_subcmd_end},
3114 {"endlist", gl_subcmd_endlist},
3115 {"evalcoord1", gl_subcmd_evalcoord1},
3116 {"evalcoord2", gl_subcmd_evalcoord2},
3117 {"evalmesh1", gl_subcmd_evalmesh1},
3118 {"evalmesh2", gl_subcmd_evalmesh2},
3119 {"flush", gl_subcmd_flush},
3120 {"fog", gl_subcmd_fog},
3121 {"frontface", gl_subcmd_frontface},
3122 {"frustum", gl_subcmd_frustum},
3123 {"genlists", gl_subcmd_genlists},
3124 {"gentextures", gl_subcmd_gentextures},
3125 {"hint", gl_subcmd_hint},
3126 {"initnames", gl_subcmd_initnames},
3127 {"light", gl_subcmd_light},
3128 {"lightmodel", gl_subcmd_lightmodel},
3129 {"loadmatrix", gl_subcmd_loadmatrix},
3130 {"lookat", gl_subcmd_lookat},
3131 {"linestipple", gl_subcmd_linestipple},
3132 {"linewidth", gl_subcmd_linewidth},
3133 {"loadidentity", gl_subcmd_loadidentity},
3134 {"loadname", gl_subcmd_loadname},
3135 {"map1", gl_subcmd_map1},
3136 {"map2", gl_subcmd_map2},
3137 {"mapgrid1", gl_subcmd_mapgrid1},
3138 {"mapgrid2", gl_subcmd_mapgrid2},
3139 {"material", gl_subcmd_material},
3140 {"matrixmode", gl_subcmd_matrixmode},
3141 {"multmatrix", gl_subcmd_multmatrix},
3142 {"newlist", gl_subcmd_newlist},
3143 {"normal", gl_subcmd_normal},
3144 {"ortho", gl_subcmd_ortho},
3145 {"perspective", gl_subcmd_perspective},
3146 {"pickmatrix", gl_subcmd_pickmatrix},
3147 {"pixeltransfer", gl_subcmd_pixeltransfer},
3148 {"pixelzoom", gl_subcmd_pixelzoom},
3149 {"polygonmode", gl_subcmd_polygonmode},
3150 {"pointsize", gl_subcmd_pointsize},
3151 {"popattrib", gl_subcmd_popattrib},
3152 {"popclientattrib", gl_subcmd_popclientattrib},
3153 {"popmatrix", gl_subcmd_popmatrix},
3154 {"popname", gl_subcmd_popname},
3155 {"pushattrib", gl_subcmd_pushattrib},
3156 {"pushclientattrib", gl_subcmd_pushclientattrib},
3157 {"pushmatrix", gl_subcmd_pushmatrix},
3158 {"pushname", gl_subcmd_pushname},
3159 {"rasterpos", gl_subcmd_rasterpos},
3160 #if 0
3161 {"readpixels", gl_subcmd_readpixels},
3162 #endif
3163 {"readbuffer", gl_subcmd_readbuffer},
3164 {"rect", gl_subcmd_rect},
3165 {"rotate", gl_subcmd_rotate},
3166 {"scale", gl_subcmd_scale},
3167 {"scissor", gl_subcmd_scissor},
3168 {"shademodel", gl_subcmd_shademodel},
3169 {"stencilfunc", gl_subcmd_stencilfunc},
3170 {"stencilmask", gl_subcmd_stencilmask},
3171 {"stencilop", gl_subcmd_stencilop},
3172 {"texcoord", gl_subcmd_texcoord},
3173 {"texenv", gl_subcmd_texenv},
3174 {"texgen", gl_subcmd_texgen},
3175 #if 0
3176 {"teximage1d", gl_subcmd_teximage1d},
3177 {"teximage2d", gl_subcmd_teximage2d},
3178 #endif
3179 {"texparameter", gl_subcmd_texparameter},
3180 {"translate", gl_subcmd_translate},
3181 {"vertex", gl_subcmd_vertex},
3182 {"viewport", gl_subcmd_viewport},
3183 {NULL},
3184 };
3185
glut_subcmd_display_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3186 static int glut_subcmd_display_func (Tcl_Interp *interp,
3187 int objc, Tcl_Obj *CONST objv[])
3188 {
3189 int value;
3190
3191 Tcl_GetIntFromObj (interp, objv[2], &value);
3192 tcl_SetGlutCallback (interp, &display_cb, objv[1], value);
3193 return 2;
3194 }
3195
glut_subcmd_reshape_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3196 static int glut_subcmd_reshape_func (Tcl_Interp *interp,
3197 int objc, Tcl_Obj *CONST objv[])
3198 {
3199 int value;
3200
3201 Tcl_GetIntFromObj (interp, objv[2], &value);
3202 tcl_SetGlutCallback (interp, &reshape_cb, objv[1], value);
3203 return 2;
3204 }
3205
glut_subcmd_keyboard_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3206 static int glut_subcmd_keyboard_func (Tcl_Interp *interp,
3207 int objc, Tcl_Obj *CONST objv[])
3208 {
3209 int value;
3210
3211 Tcl_GetIntFromObj (interp, objv[2], &value);
3212 tcl_SetGlutCallback (interp, &keyboard_cb, objv[1], value);
3213 return 2;
3214 }
3215
glut_subcmd_keyboard_up_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3216 static int glut_subcmd_keyboard_up_func (Tcl_Interp *interp,
3217 int objc, Tcl_Obj *CONST objv[])
3218 {
3219 int value;
3220
3221 Tcl_GetIntFromObj (interp, objv[2], &value);
3222 tcl_SetGlutCallback (interp, &keyboard_up_cb, objv[1], value);
3223 glutKeyboardUpFunc (tcl_KeyboardUpFunc);
3224 return 2;
3225 }
3226
glut_subcmd_mouse_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3227 static int glut_subcmd_mouse_func (Tcl_Interp *interp,
3228 int objc, Tcl_Obj *CONST objv[])
3229 {
3230 int value;
3231
3232 Tcl_GetIntFromObj (interp, objv[2], &value);
3233 tcl_SetGlutCallback (interp, &mouse_cb, objv[1], value);
3234 return 2;
3235 }
3236
glut_subcmd_motion_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3237 static int glut_subcmd_motion_func (Tcl_Interp *interp,
3238 int objc, Tcl_Obj *CONST objv[])
3239 {
3240 int value;
3241
3242 Tcl_GetIntFromObj (interp, objv[2], &value);
3243 tcl_SetGlutCallback (interp, &motion_cb, objv[1], value);
3244 glutMotionFunc (tcl_MotionFunc);
3245 return 2;
3246 }
3247
glut_subcmd_passive_motion_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3248 static int glut_subcmd_passive_motion_func (Tcl_Interp *interp,
3249 int objc, Tcl_Obj *CONST objv[])
3250 {
3251 int value;
3252
3253 Tcl_GetIntFromObj (interp, objv[2], &value);
3254 tcl_SetGlutCallback (interp, &passive_motion_cb, objv[1], value);
3255 return 2;
3256 }
3257
glut_subcmd_entry_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3258 static int glut_subcmd_entry_func (Tcl_Interp *interp,
3259 int objc, Tcl_Obj *CONST objv[])
3260 {
3261 int value;
3262
3263 Tcl_GetIntFromObj (interp, objv[2], &value);
3264 tcl_SetGlutCallback (interp, &entry_cb, objv[1], value);
3265 glutEntryFunc (tcl_EntryFunc);
3266 return 2;
3267 }
3268
glut_subcmd_visibility_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3269 static int glut_subcmd_visibility_func (Tcl_Interp *interp,
3270 int objc, Tcl_Obj *CONST objv[])
3271 {
3272 int value;
3273
3274 Tcl_GetIntFromObj (interp, objv[2], &value);
3275 tcl_SetGlutCallback (interp, &visibility_cb, objv[1], value);
3276 glutVisibilityFunc (tcl_VisibilityFunc);
3277 return 2;
3278 }
3279
glut_subcmd_idle_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3280 static int glut_subcmd_idle_func (Tcl_Interp *interp,
3281 int objc, Tcl_Obj *CONST objv[])
3282 {
3283 int value;
3284
3285 Tcl_GetIntFromObj (interp, objv[2], &value);
3286 idle_cb.interp = interp;
3287 idle_cb.obj = objv[1];
3288 Tcl_IncrRefCount (objv[1]);
3289 glutIdleFunc (tcl_IdleFunc);
3290 return 2;
3291 }
3292
glut_subcmd_timer_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3293 static int glut_subcmd_timer_func (Tcl_Interp *interp,
3294 int objc, Tcl_Obj *CONST objv[])
3295 {
3296 long millis;
3297 int value;
3298
3299 Tcl_GetLongFromObj (interp, objv[1], &millis);
3300 Tcl_GetIntFromObj (interp, objv[2], &value);
3301 tcl_InstallGlutCallback (interp, &glut_timer_hash, objv[3], value, value);
3302 glutTimerFunc (millis, tcl_TimerFunc, value);
3303 return 4;
3304 }
3305
glut_subcmd_menu_state_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3306 static int glut_subcmd_menu_state_func (Tcl_Interp *interp,
3307 int objc, Tcl_Obj *CONST objv[])
3308 {
3309 int value;
3310
3311 Tcl_GetIntFromObj (interp, objv[2], &value);
3312 tcl_SetGlutCallback (interp, &menu_state_cb, objv[1], value);
3313 glutMenuStateFunc (tcl_MenuStateFunc);
3314 return 2;
3315 }
3316
glut_subcmd_special_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3317 static int glut_subcmd_special_func (Tcl_Interp *interp,
3318 int objc, Tcl_Obj *CONST objv[])
3319 {
3320 int value;
3321
3322 Tcl_GetIntFromObj (interp, objv[2], &value);
3323 tcl_SetGlutCallback (interp, &special_cb, objv[1], value);
3324
3325 return 2;
3326 }
3327
glut_subcmd_special_up_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3328 static int glut_subcmd_special_up_func (Tcl_Interp *interp,
3329 int objc, Tcl_Obj *CONST objv[])
3330 {
3331 int value;
3332
3333 Tcl_GetIntFromObj (interp, objv[2], &value);
3334 tcl_SetGlutCallback (interp, &special_up_cb, objv[1], value);
3335 glutSpecialUpFunc (tcl_SpecialUpFunc);
3336
3337 return 2;
3338 }
3339
glut_subcmd_tablet_motion_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3340 static int glut_subcmd_tablet_motion_func (Tcl_Interp *interp,
3341 int objc, Tcl_Obj *CONST objv[])
3342 {
3343 int value;
3344
3345 Tcl_GetIntFromObj (interp, objv[2], &value);
3346 tcl_SetGlutCallback (interp, &tablet_motion_cb, objv[1], value);
3347 glutTabletMotionFunc (tcl_TabletMotionFunc);
3348 return 2;
3349 }
3350
glut_subcmd_tablet_button_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3351 static int glut_subcmd_tablet_button_func (Tcl_Interp *interp,
3352 int objc, Tcl_Obj *CONST objv[])
3353 {
3354 int value;
3355
3356 Tcl_GetIntFromObj (interp, objv[2], &value);
3357 tcl_SetGlutCallback (interp, &tablet_button_cb, objv[1], value);
3358 glutTabletButtonFunc (tcl_TabletButtonFunc);
3359 return 2;
3360 }
3361
glut_subcmd_menu_status_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3362 static int glut_subcmd_menu_status_func (Tcl_Interp *interp,
3363 int objc, Tcl_Obj *CONST objv[])
3364 {
3365 int value;
3366
3367 Tcl_GetIntFromObj (interp, objv[2], &value);
3368 tcl_SetGlutCallback (interp, &menu_status_cb, objv[1], value);
3369 glutMenuStatusFunc (tcl_MenuStatusFunc);
3370 return 2;
3371 }
3372
glut_subcmd_window_status_func(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3373 static int glut_subcmd_window_status_func (Tcl_Interp *interp,
3374 int objc, Tcl_Obj *CONST objv[])
3375 {
3376 int value;
3377
3378 Tcl_GetIntFromObj (interp, objv[2], &value);
3379 tcl_SetGlutCallback (interp, &window_status_cb, objv[1], value);
3380 glutWindowStatusFunc (tcl_WindowStatusFunc);
3381 return 2;
3382 }
3383
glut_subcmd_window_position(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3384 static int glut_subcmd_window_position (Tcl_Interp *interp,
3385 int objc, Tcl_Obj *CONST objv[])
3386 {
3387 int x, y;
3388
3389 if (objc < 3)
3390 goto ERROR;
3391
3392 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &x), ERROR);
3393 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &y), ERROR);
3394
3395 glutInitWindowPosition (x, y);
3396 return 3;
3397
3398 ERROR:
3399 Tcl_AppendResult (interp, ": wrong # args. should be <x> <y>.", NULL);
3400 return 0;
3401 }
3402
glut_subcmd_window_size(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3403 static int glut_subcmd_window_size (Tcl_Interp *interp,
3404 int objc, Tcl_Obj *CONST objv[])
3405 {
3406 int w, h;
3407
3408 if (objc < 3)
3409 goto ERROR;
3410
3411 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &w), ERROR);
3412 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &h), ERROR);
3413
3414 glutInitWindowSize (w, h);
3415 return 3;
3416
3417 ERROR:
3418 Tcl_AppendResult (interp, ": wrong # args. should be <w> <h>.", NULL);
3419 return 0;
3420 }
3421
glut_subcmd_create_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3422 static int glut_subcmd_create_window (Tcl_Interp *interp,
3423 int objc, Tcl_Obj *CONST objv[])
3424 {
3425 return 1;
3426 }
3427
glut_subcmd_create_subwindow(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3428 static int glut_subcmd_create_subwindow (Tcl_Interp *interp,
3429 int objc, Tcl_Obj *CONST objv[])
3430 {
3431 return 1;
3432 }
3433
glut_subcmd_destroy_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3434 static int glut_subcmd_destroy_window (Tcl_Interp *interp,
3435 int objc, Tcl_Obj *CONST objv[])
3436 {
3437 return 1;
3438 }
3439
glut_subcmd_post_redisplay(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3440 static int glut_subcmd_post_redisplay (Tcl_Interp *interp,
3441 int objc, Tcl_Obj *CONST objv[])
3442 {
3443 glutPostRedisplay ();
3444 return 1;
3445 }
3446
glut_subcmd_swap_buffers(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3447 static int glut_subcmd_swap_buffers (Tcl_Interp *interp,
3448 int objc, Tcl_Obj *CONST objv[])
3449 {
3450 glutSwapBuffers ();
3451 return 1;
3452 }
3453
glut_subcmd_set_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3454 static int glut_subcmd_set_window (Tcl_Interp *interp,
3455 int objc, Tcl_Obj *CONST objv[])
3456 {
3457 return 1;
3458 }
3459
glut_subcmd_set_window_title(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3460 static int glut_subcmd_set_window_title (Tcl_Interp *interp,
3461 int objc, Tcl_Obj *CONST objv[])
3462 {
3463 return 1;
3464 }
3465
glut_subcmd_set_icon_title(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3466 static int glut_subcmd_set_icon_title (Tcl_Interp *interp,
3467 int objc, Tcl_Obj *CONST objv[])
3468 {
3469 return 1;
3470 }
3471
glut_subcmd_position_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3472 static int glut_subcmd_position_window (Tcl_Interp *interp,
3473 int objc, Tcl_Obj *CONST objv[])
3474 {
3475 return 1;
3476 }
3477
glut_subcmd_reshape_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3478 static int glut_subcmd_reshape_window (Tcl_Interp *interp,
3479 int objc, Tcl_Obj *CONST objv[])
3480 {
3481 int width;
3482 int height;
3483
3484 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[1], &width), ERROR);
3485 TCL_CHECK(Tcl_GetIntFromObj (interp, objv[2], &height), ERROR);
3486
3487 glutReshapeWindow (width, height);
3488 return 3;
3489
3490 ERROR:
3491 OBJ_RESULT(objv[0], ": wrong # args. should be width height");
3492 return 0;
3493 }
3494
glut_subcmd_pop_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3495 static int glut_subcmd_pop_window (Tcl_Interp *interp,
3496 int objc, Tcl_Obj *CONST objv[])
3497 {
3498 return 1;
3499 }
3500
glut_subcmd_push_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3501 static int glut_subcmd_push_window (Tcl_Interp *interp,
3502 int objc, Tcl_Obj *CONST objv[])
3503 {
3504 return 1;
3505 }
3506
glut_subcmd_iconify_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3507 static int glut_subcmd_iconify_window (Tcl_Interp *interp,
3508 int objc, Tcl_Obj *CONST objv[])
3509 {
3510 return 1;
3511 }
3512
glut_subcmd_show_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3513 static int glut_subcmd_show_window (Tcl_Interp *interp,
3514 int objc, Tcl_Obj *CONST objv[])
3515 {
3516 return 1;
3517 }
3518
glut_subcmd_hide_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3519 static int glut_subcmd_hide_window (Tcl_Interp *interp,
3520 int objc, Tcl_Obj *CONST objv[])
3521 {
3522 return 1;
3523 }
3524
glut_subcmd_get_window(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3525 static int glut_subcmd_get_window (Tcl_Interp *interp,
3526 int objc, Tcl_Obj *CONST objv[])
3527 {
3528 return 1;
3529 }
3530
glut_subcmd_full_screen(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3531 static int glut_subcmd_full_screen (Tcl_Interp *interp,
3532 int objc, Tcl_Obj *CONST objv[])
3533 {
3534 return 1;
3535 }
3536
glut_subcmd_set_cursor(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3537 static int glut_subcmd_set_cursor (Tcl_Interp *interp,
3538 int objc, Tcl_Obj *CONST objv[])
3539 {
3540 return 1;
3541 }
3542
glut_subcmd_warp_pointer(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3543 static int glut_subcmd_warp_pointer (Tcl_Interp *interp,
3544 int objc, Tcl_Obj *CONST objv[])
3545 {
3546 return 1;
3547 }
3548
glut_subcmd_create_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3549 static int glut_subcmd_create_menu (Tcl_Interp *interp,
3550 int objc, Tcl_Obj *CONST objv[])
3551 {
3552 return 1;
3553 }
3554
glut_subcmd_destroy_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3555 static int glut_subcmd_destroy_menu (Tcl_Interp *interp,
3556 int objc, Tcl_Obj *CONST objv[])
3557 {
3558 return 1;
3559 }
3560
glut_subcmd_get_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3561 static int glut_subcmd_get_menu (Tcl_Interp *interp,
3562 int objc, Tcl_Obj *CONST objv[])
3563 {
3564 return 1;
3565 }
3566
glut_subcmd_set_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3567 static int glut_subcmd_set_menu (Tcl_Interp *interp,
3568 int objc, Tcl_Obj *CONST objv[])
3569 {
3570 return 1;
3571 }
3572
glut_subcmd_add_menu_entry(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3573 static int glut_subcmd_add_menu_entry (Tcl_Interp *interp,
3574 int objc, Tcl_Obj *CONST objv[])
3575 {
3576 return 1;
3577 }
3578
glut_subcmd_add_sub_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3579 static int glut_subcmd_add_sub_menu (Tcl_Interp *interp,
3580 int objc, Tcl_Obj *CONST objv[])
3581 {
3582 return 1;
3583 }
3584
glut_subcmd_change_to_menu_entry(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3585 static int glut_subcmd_change_to_menu_entry (Tcl_Interp *interp,
3586 int objc, Tcl_Obj *CONST objv[])
3587 {
3588 return 1;
3589 }
3590
glut_subcmd_change_to_sub_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3591 static int glut_subcmd_change_to_sub_menu (Tcl_Interp *interp,
3592 int objc, Tcl_Obj *CONST objv[])
3593 {
3594 return 1;
3595 }
3596
glut_subcmd_remove_menu_item(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3597 static int glut_subcmd_remove_menu_item (Tcl_Interp *interp,
3598 int objc, Tcl_Obj *CONST objv[])
3599 {
3600 return 1;
3601 }
3602
glut_subcmd_attach_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3603 static int glut_subcmd_attach_menu (Tcl_Interp *interp,
3604 int objc, Tcl_Obj *CONST objv[])
3605 {
3606 return 1;
3607 }
3608
glut_subcmd_detach_menu(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3609 static int glut_subcmd_detach_menu (Tcl_Interp *interp,
3610 int objc, Tcl_Obj *CONST objv[])
3611 {
3612 return 1;
3613 }
3614
glut_subcmd_get(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3615 static int glut_subcmd_get (Tcl_Interp *interp,
3616 int objc, Tcl_Obj *CONST objv[])
3617 {
3618 return 1;
3619 }
3620
glut_subcmd_device_get(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3621 static int glut_subcmd_device_get (Tcl_Interp *interp,
3622 int objc, Tcl_Obj *CONST objv[])
3623 {
3624 return 1;
3625 }
3626
glut_subcmd_get_modifiers(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3627 static int glut_subcmd_get_modifiers (Tcl_Interp *interp,
3628 int objc, Tcl_Obj *CONST objv[])
3629 {
3630 return 1;
3631 }
3632
glut_subcmd_bitmap_character(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3633 static int glut_subcmd_bitmap_character (Tcl_Interp *interp,
3634 int objc, Tcl_Obj *CONST objv[])
3635 {
3636 int i, len;
3637 void *font = GetGlutEnum (objv[1]);
3638 char *string = Tcl_GetStringFromObj (objv[2], &len);
3639
3640 for (i=0; i < len; i++) {
3641 glutBitmapCharacter (font, string[i]);
3642 }
3643
3644 return 3;
3645 }
3646
glut_subcmd_bitmap_width(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3647 static int glut_subcmd_bitmap_width (Tcl_Interp *interp,
3648 int objc, Tcl_Obj *CONST objv[])
3649 {
3650 return 1;
3651 }
3652
glut_subcmd_stroke_character(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3653 static int glut_subcmd_stroke_character (Tcl_Interp *interp,
3654 int objc, Tcl_Obj *CONST objv[])
3655 {
3656 int i;
3657 void *font = GetGlutEnum (objv[1]);
3658 char *string = Tcl_GetStringFromObj (objv[2], NULL);
3659
3660 for (i=0; string[i] != '\0'; i++) {
3661 glutStrokeCharacter (font, string[i]);
3662 }
3663
3664 return 3;
3665 }
3666
glut_subcmd_stroke_width(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3667 static int glut_subcmd_stroke_width (Tcl_Interp *interp,
3668 int objc, Tcl_Obj *CONST objv[])
3669 {
3670 return 1;
3671 }
3672
glut_subcmd_bitmap_length(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3673 static int glut_subcmd_bitmap_length (Tcl_Interp *interp,
3674 int objc, Tcl_Obj *CONST objv[])
3675 {
3676 return 1;
3677 }
3678
glut_subcmd_stroke_length(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3679 static int glut_subcmd_stroke_length (Tcl_Interp *interp,
3680 int objc, Tcl_Obj *CONST objv[])
3681 {
3682 return 1;
3683 }
3684
glut_subcmd_wire_sphere(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3685 static int glut_subcmd_wire_sphere (Tcl_Interp *interp,
3686 int objc, Tcl_Obj *CONST objv[])
3687 {
3688 return 1;
3689 }
3690
glut_subcmd_solid_sphere(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3691 static int glut_subcmd_solid_sphere (Tcl_Interp *interp,
3692 int objc, Tcl_Obj *CONST objv[])
3693 {
3694 return 1;
3695 }
3696
glut_subcmd_wire_cone(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3697 static int glut_subcmd_wire_cone (Tcl_Interp *interp,
3698 int objc, Tcl_Obj *CONST objv[])
3699 {
3700 return 1;
3701 }
3702
glut_subcmd_solid_cone(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3703 static int glut_subcmd_solid_cone (Tcl_Interp *interp,
3704 int objc, Tcl_Obj *CONST objv[])
3705 {
3706 return 1;
3707 }
3708
glut_subcmd_wire_cube(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3709 static int glut_subcmd_wire_cube (Tcl_Interp *interp,
3710 int objc, Tcl_Obj *CONST objv[])
3711 {
3712 return 1;
3713 }
3714
glut_subcmd_solid_cube(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3715 static int glut_subcmd_solid_cube (Tcl_Interp *interp,
3716 int objc, Tcl_Obj *CONST objv[])
3717 {
3718 return 1;
3719 }
3720
glut_subcmd_wire_torus(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3721 static int glut_subcmd_wire_torus (Tcl_Interp *interp,
3722 int objc, Tcl_Obj *CONST objv[])
3723 {
3724 return 1;
3725 }
3726
glut_subcmd_solid_torus(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3727 static int glut_subcmd_solid_torus (Tcl_Interp *interp,
3728 int objc, Tcl_Obj *CONST objv[])
3729 {
3730 return 1;
3731 }
3732
glut_subcmd_wire_dodecahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3733 static int glut_subcmd_wire_dodecahedron (Tcl_Interp *interp,
3734 int objc, Tcl_Obj *CONST objv[])
3735 {
3736 return 1;
3737 }
3738
glut_subcmd_solid_dodecahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3739 static int glut_subcmd_solid_dodecahedron (Tcl_Interp *interp,
3740 int objc, Tcl_Obj *CONST objv[])
3741 {
3742 return 1;
3743 }
3744
glut_subcmd_wire_teapot(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3745 static int glut_subcmd_wire_teapot (Tcl_Interp *interp,
3746 int objc, Tcl_Obj *CONST objv[])
3747 {
3748 return 1;
3749 }
3750
glut_subcmd_solid_teapot(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3751 static int glut_subcmd_solid_teapot (Tcl_Interp *interp,
3752 int objc, Tcl_Obj *CONST objv[])
3753 {
3754 return 1;
3755 }
3756
glut_subcmd_wire_octahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3757 static int glut_subcmd_wire_octahedron (Tcl_Interp *interp,
3758 int objc, Tcl_Obj *CONST objv[])
3759 {
3760 return 1;
3761 }
3762
glut_subcmd_solid_octahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3763 static int glut_subcmd_solid_octahedron (Tcl_Interp *interp,
3764 int objc, Tcl_Obj *CONST objv[])
3765 {
3766 return 1;
3767 }
3768
glut_subcmd_wire_tetrahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3769 static int glut_subcmd_wire_tetrahedron (Tcl_Interp *interp,
3770 int objc, Tcl_Obj *CONST objv[])
3771 {
3772 return 1;
3773 }
3774
glut_subcmd_solid_tetrahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3775 static int glut_subcmd_solid_tetrahedron (Tcl_Interp *interp,
3776 int objc, Tcl_Obj *CONST objv[])
3777 {
3778 return 1;
3779 }
3780
glut_subcmd_wire_icosahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3781 static int glut_subcmd_wire_icosahedron (Tcl_Interp *interp,
3782 int objc, Tcl_Obj *CONST objv[])
3783 {
3784 return 1;
3785 }
3786
glut_subcmd_solid_icosahedron(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3787 static int glut_subcmd_solid_icosahedron (Tcl_Interp *interp,
3788 int objc, Tcl_Obj *CONST objv[])
3789 {
3790 return 1;
3791 }
3792
glut_subcmd_video_resize_get(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3793 static int glut_subcmd_video_resize_get (Tcl_Interp *interp,
3794 int objc, Tcl_Obj *CONST objv[])
3795 {
3796 return 1;
3797 }
3798
glut_subcmd_setup_video_resizing(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3799 static int glut_subcmd_setup_video_resizing (Tcl_Interp *interp,
3800 int objc, Tcl_Obj *CONST objv[])
3801 {
3802 return 1;
3803 }
3804
glut_subcmd_stop_video_resizing(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3805 static int glut_subcmd_stop_video_resizing (Tcl_Interp *interp,
3806 int objc, Tcl_Obj *CONST objv[])
3807 {
3808 return 1;
3809 }
3810
glut_subcmd_video_resize(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3811 static int glut_subcmd_video_resize (Tcl_Interp *interp,
3812 int objc, Tcl_Obj *CONST objv[])
3813 {
3814 return 1;
3815 }
3816
glut_subcmd_video_pan(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3817 static int glut_subcmd_video_pan (Tcl_Interp *interp,
3818 int objc, Tcl_Obj *CONST objv[])
3819 {
3820 return 1;
3821 }
3822
glut_subcmd_report_errors(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3823 static int glut_subcmd_report_errors (Tcl_Interp *interp,
3824 int objc, Tcl_Obj *CONST objv[])
3825 {
3826 return 1;
3827 }
3828
glut_subcmd_ignore_keyrepeat(Tcl_Interp * interp,int objc,Tcl_Obj * CONST objv[])3829 static int glut_subcmd_ignore_keyrepeat (Tcl_Interp *interp,
3830 int objc, Tcl_Obj *CONST objv[])
3831 {
3832 int value;
3833
3834 if (objc < 2 ||
3835 Tcl_GetBooleanFromObj (interp, objv[1], &value) == TCL_ERROR) {
3836 Tcl_AppendResult (interp, ": -ignorekeyrepeat <bool>.", NULL);
3837 return 0;
3838 }
3839 glutIgnoreKeyRepeat (value);
3840
3841 return 2;
3842 }
3843
3844
3845 static GrFunctionList glutfunclist[] = {
3846 {"displayfunc", glut_subcmd_display_func},
3847 {"reshapefunc", glut_subcmd_reshape_func},
3848 {"keyboardfunc", glut_subcmd_keyboard_func},
3849 {"keyboardupfunc", glut_subcmd_keyboard_up_func},
3850 {"mousefunc", glut_subcmd_mouse_func},
3851 {"motionfunc", glut_subcmd_motion_func},
3852 {"passivemotionfunc", glut_subcmd_passive_motion_func},
3853 {"entryfunc", glut_subcmd_entry_func},
3854 {"visibilityfunc", glut_subcmd_visibility_func},
3855 {"idlefunc", glut_subcmd_idle_func},
3856 {"timerfunc", glut_subcmd_timer_func},
3857 {"menustatefunc", glut_subcmd_menu_state_func},
3858 {"specialfunc", glut_subcmd_special_func},
3859 {"specialupfunc", glut_subcmd_special_up_func},
3860 {"tabletmotionfunc", glut_subcmd_tablet_motion_func},
3861 {"tabletbuttonfunc", glut_subcmd_tablet_button_func},
3862 {"menustatusfunc", glut_subcmd_menu_status_func},
3863 {"windowstatusfunc", glut_subcmd_window_status_func},
3864 {"initwindowposition", glut_subcmd_window_position},
3865 {"initwindowsize", glut_subcmd_window_size},
3866 {"createwindow", glut_subcmd_create_window},
3867 {"createsubwindow", glut_subcmd_create_subwindow},
3868 {"destroywindow", glut_subcmd_destroy_window},
3869 {"postredisplay", glut_subcmd_post_redisplay},
3870 {"swapbuffers", glut_subcmd_swap_buffers},
3871 {"getwindow", glut_subcmd_get_window},
3872 {"setwindow", glut_subcmd_set_window},
3873 {"setwindow_title", glut_subcmd_set_window_title},
3874 {"seticontitle", glut_subcmd_set_icon_title},
3875 {"positionwindow", glut_subcmd_position_window},
3876 {"reshapewindow", glut_subcmd_reshape_window},
3877 {"popwindow", glut_subcmd_pop_window},
3878 {"pushwindow", glut_subcmd_push_window},
3879 {"iconifywindow", glut_subcmd_iconify_window},
3880 {"showwindow", glut_subcmd_show_window},
3881 {"hidewindow", glut_subcmd_hide_window},
3882 {"fullscreen", glut_subcmd_full_screen},
3883 {"setcursor", glut_subcmd_set_cursor},
3884 {"warppointer", glut_subcmd_warp_pointer},
3885 {"createmenu", glut_subcmd_create_menu},
3886 {"destroymenu", glut_subcmd_destroy_menu},
3887 {"getmenu", glut_subcmd_get_menu},
3888 {"setmenu", glut_subcmd_set_menu},
3889 {"addmenuentry", glut_subcmd_add_menu_entry},
3890 {"addsubmenu", glut_subcmd_add_sub_menu},
3891 {"changetomenuentry", glut_subcmd_change_to_menu_entry},
3892 {"changetosubmenu", glut_subcmd_change_to_sub_menu},
3893 {"removemenuitem", glut_subcmd_remove_menu_item},
3894 {"attachmenu", glut_subcmd_attach_menu},
3895 {"detachmenu", glut_subcmd_detach_menu},
3896 {"get", glut_subcmd_get},
3897 {"deviceget", glut_subcmd_device_get},
3898 {"getmodifiers", glut_subcmd_get_modifiers},
3899 {"bitmapcharacter", glut_subcmd_bitmap_character},
3900 {"bitmapwidth", glut_subcmd_bitmap_width},
3901 {"strokecharacter", glut_subcmd_stroke_character},
3902 {"strokewidth", glut_subcmd_stroke_width},
3903 {"bitmaplength", glut_subcmd_bitmap_length},
3904 {"strokelength", glut_subcmd_stroke_length},
3905 {"wiresphere", glut_subcmd_wire_sphere},
3906 {"solidsphere", glut_subcmd_solid_sphere},
3907 {"wirecone", glut_subcmd_wire_cone},
3908 {"solidcone", glut_subcmd_solid_cone},
3909 {"wirecube", glut_subcmd_wire_cube},
3910 {"solidcube", glut_subcmd_solid_cube},
3911 {"wiretorus", glut_subcmd_wire_torus},
3912 {"solidtorus", glut_subcmd_solid_torus},
3913 {"wiredodecahedron", glut_subcmd_wire_dodecahedron},
3914 {"soliddodecahedron", glut_subcmd_solid_dodecahedron},
3915 {"wireteapot", glut_subcmd_wire_teapot},
3916 {"solidteapot", glut_subcmd_solid_teapot},
3917 {"wireoctahedron", glut_subcmd_wire_octahedron},
3918 {"solidoctahedron", glut_subcmd_solid_octahedron},
3919 {"wiretetrahedron", glut_subcmd_wire_tetrahedron},
3920 {"solidtetrahedron", glut_subcmd_solid_tetrahedron},
3921 {"wireicosahedron", glut_subcmd_wire_icosahedron},
3922 {"solidicosahedron", glut_subcmd_solid_icosahedron},
3923 {"videoresizeget", glut_subcmd_video_resize_get},
3924 {"setupvideoresizing", glut_subcmd_setup_video_resizing},
3925 {"stopvideoresizing", glut_subcmd_stop_video_resizing},
3926 {"videoresize", glut_subcmd_video_resize},
3927 {"videopan", glut_subcmd_video_pan},
3928 {"reporterrors", glut_subcmd_report_errors},
3929 {"ignorekeyrepeat", glut_subcmd_ignore_keyrepeat},
3930 {NULL, NULL},
3931 };
3932
3933 static int
real_init(Tcl_Interp * interp)3934 real_init (Tcl_Interp *interp)
3935 {
3936 static int do_init = 1;
3937 int i;
3938 int _new;
3939 Tcl_HashEntry *entry;
3940
3941 if (do_init) {
3942 do_init = 0;
3943
3944 Tcl_InitHashTable (&gl_enum_hash, TCL_STRING_KEYS);
3945 Tcl_InitHashTable (&gl_func_hash, TCL_STRING_KEYS);
3946 Tcl_InitHashTable (&glut_enum_hash, TCL_STRING_KEYS);
3947 Tcl_InitHashTable (&glut_func_hash, TCL_STRING_KEYS);
3948 Tcl_InitHashTable (&scene_hash, TCL_ONE_WORD_KEYS);
3949 Tcl_InitHashTable (&glut_timer_hash, TCL_ONE_WORD_KEYS);
3950 Tcl_InitHashTable (&cache_hash, TCL_STRING_KEYS);
3951
3952 obj_x = Tcl_NewStringObj ("X", 1);
3953 obj_y = Tcl_NewStringObj ("Y", 1);
3954 obj_width = Tcl_NewStringObj ("WIDTH", 5);
3955 obj_height = Tcl_NewStringObj ("HEIGHT", 6);
3956 obj_state = Tcl_NewStringObj ("STATE", 5);
3957 obj_status = Tcl_NewStringObj ("STATUS", 6);
3958 obj_key = Tcl_NewStringObj ("KEY", 3);
3959 obj_button = Tcl_NewStringObj ("BUTTON", 6);
3960 obj_value = Tcl_NewStringObj ("VALUE", 5);
3961
3962 for (i=0; glwordlist[i].name != NULL; i++) {
3963 entry = Tcl_CreateHashEntry (&gl_enum_hash, glwordlist[i].name, &_new);
3964 Tcl_SetHashValue (entry, (ClientData) glwordlist[i].val);
3965 }
3966
3967 for (i=0; glfunclist[i].name != NULL; i++) {
3968 entry = Tcl_CreateHashEntry (&gl_func_hash,
3969 glfunclist[i].name, &_new);
3970 Tcl_SetHashValue (entry, (ClientData) &glfunclist[i]);
3971 }
3972
3973 for (i=0; glutwordlist[i].name != NULL; i++) {
3974 entry = Tcl_CreateHashEntry (&glut_enum_hash,
3975 glutwordlist[i].name, &_new);
3976 Tcl_SetHashValue (entry, (ClientData) glutwordlist[i].val);
3977 }
3978
3979 for (i=0; glutfunclist[i].name != NULL; i++) {
3980 entry = Tcl_CreateHashEntry (&glut_func_hash,
3981 glutfunclist[i].name, &_new);
3982 Tcl_SetHashValue (entry, (ClientData) &glutfunclist[i]);
3983 }
3984 }
3985
3986 Tcl_CreateObjCommand (interp, "gl", GlCmd, NULL, NULL);
3987 Tcl_CreateObjCommand (interp, "glut", GlutCmd, NULL, NULL);
3988 Tcl_CreateObjCommand (interp, "gr::scene", grSceneCmd, NULL, NULL);
3989
3990 return TCL_OK;
3991 }
3992
3993 int
Glbind_Init(Tcl_Interp * interp)3994 Glbind_Init (Tcl_Interp *interp)
3995 {
3996 main_interp = interp;
3997
3998 return real_init (interp);
3999 }
4000
4001 int
Glbind_SafeInit(Tcl_Interp * interp)4002 Glbind_SafeInit (Tcl_Interp *interp)
4003 {
4004 return real_init (interp);
4005 }
4006