Posted to tcl by dbohdan at Fri Feb 06 21:16:34 GMT 2015view raw

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