| Context: | TOC -> GLUT/Tk Overview -> Application Development -> Example |
For the entire source code, please use the download page. On this page we will exhibit only the code segments that directly use the new GLUT/Tk features. The ellipses (... like this ...) give a rough idea of what the missing code is doing.
... global definitions ...
/* =============================================================== */
int main (int argc, char *argv[])
{
int err_code, win_ID, GLwire, ix;
const char *app_name = "Platonics";
... pre-GLUT initialization ...
glutInit (&argc, argv);
glutInitDisplayMode (GLUT_DOUBLE | GLUT_RGB | GLUT_DEPTH);
glutInitWindowSize (win_size_x, win_size_y);
/* here's where the Tcl process gets launched and associated
with a GLUT window.
*/
win_ID = glutCreateWindow4Tcl (app_name, "./ctl.tk", "Dummy",
using_sb ? "y" : "n");
... set up lighting, etc...
/* build display lists for Platonic solids */
build_plato_DLs ();
/* build display list for wireframe globe */
build_globe ('w', 12,24, 100);
/* end INIT, start with GLUT stuff */
printf ("SB is %savailable.\n",
glutDeviceGet (GLUT_HAS_SPACEBALL) ? "" : "not ");
/* register glut routines */
glutDisplayFunc (display_shape);
glutKeyboardFunc (handle_keyboard);
glutReshapeFunc (handle_reshape); /* gets called at window open */
glutMouseFunc (handle_mouse_click);
glutMotionFunc (handle_mouse_move);
glutSpaceballMotionFunc (handle_sb_move);
glutSpaceballRotateFunc (handle_sb_spin);
/* NOTE: here is where we register the handler for events from Tcl */
glutTclFunc (handle_tcl_msg);
glutVisibilityFunc (handle_visibility);
glutPassiveMotionFunc (NULL);
glutIdleFunc (NULL);
/* init mouse cursor */
set_mouse_mode ('m');
glutMainLoop();
exit (0);
}
package require gluttk
### ------------------ ###
### HANDY PROCEDURES ###
### ------------------ ###
... various procedures defined first ...
### This procedure sends a list of Tcl-window identifiers to
### the GLUT process.
### --------------------------------------------------------------- ###
proc enable_glut_to_tk {win_list} {
## puts [format "win-list = %s" $win_list]
foreach win $win_list {
tcl_target $win
}
}
... more initialization ...
### The following code makes sure that GLUT knows about the
### initial state of various menu widgets
# initialize settings
set PICK 2
set MOVE 3
set SPIN 1
set cur_mouse_mode $MOVE
send_to_glut i 101 $cur_mouse_mode
set pshape 3
send_to_glut i 104 $pshape
set gl_vis 1
send_to_glut i 105 1 $gl_vis
set shrink_vis 0
send_to_glut i 105 2 $shrink_vis
### ------------------- ###
### MAJOR MENU CHUNKS ###
### ------------------- ###
... various menu chunks built here
### Here's a good example of how the results of a radiobutton choice are
### conveyed to GLUT. Note that the integer values sent to GLUT are
### meaningful only by convention. E.g. "104" means "Change current solid
### to:" and then "1" means "tetrahedron", "2" means "hexahedron", etc.
###
### --------------------------------------------------------------- ###
frame .shapes -borderwidth 3 -relief ridge
frame .shapes.rt
button .shapes.hlp -text "Shapes:" -background $help_color \
-command {explain_msg .shape_expl "Explain Shapes" \
"Platonics lets you view one Platonic solid at a time.\
Use the t, h, o, d, or i-keys as shortcuts to set the shape."}
radiobutton .shapes.rt.tetra -text "Tetrahedron" -variable pshape \
-value 1 -background $active_color -command {send_to_glut i 104 $pshape}
radiobutton .shapes.rt.hexa -text "Hexahedron" -variable pshape \
-value 2 -background $active_color -command {send_to_glut i 104 $pshape}
radiobutton .shapes.rt.octa -text "Octahedron" -variable pshape \
-value 3 -background $active_color -command {send_to_glut i 104 $pshape}
radiobutton .shapes.rt.dodec -text "Dodecahedron" -variable pshape \
-value 4 -background $active_color -command {send_to_glut i 104 $pshape}
radiobutton .shapes.rt.icosa -text "Icosahedron" -variable pshape \
-value 5 -background $active_color -command {send_to_glut i 104 $pshape}
pack .shapes.hlp -ipadx $ipx -ipady $ipy -anchor nw -side left
pack .shapes.rt -ipadx $ipx -ipady $ipy -anchor ne -side right
pack .shapes.rt.tetra .shapes.rt.hexa .shapes.rt.octa .shapes.rt.dodec \
.shapes.rt.icosa -anchor nw -side top
### Another example, in which a character string, rather
### than an integer list, is sent back.
### --------------------------------------------------------------- ###
frame .big_ops -borderwidth 3 -relief ridge
button .big_ops.help -text "Major operations:" -background $help_color\
-command {explain_msg .big_ex "Explain major operations"\
"The 'Quit' button does just that."}
# Normally, we could send a simple integer here, but this is just to
# illustrate how to send a character string.
button .big_ops.quitbut -text "Quit" -background #FF7777 \
-command {send_to_glut s "Quit!!"; exit}
pack .big_ops.help -side left
pack .big_ops.quitbut -side right
... other menu elements built here ...
# Send window information to GLUT so that GLUT can in turn
# trigger these widgets in Tcl ... but have to delay a bit
# so that the windows get created.
set targs {.mouse_mode.bot.spin .mouse_mode.bot.pick .mouse_mode.bot.move \
.shapes.rt.tetra .shapes.rt.hexa .shapes.rt.octa .shapes.rt.dodec \
.shapes.rt.icosa .style.globe}
after 800 {enable_glut_to_tk $targs}
/* =============================================================== */
void handle_tcl_msg (struct tclData *xcd)
{
int ip2, ip3, ix, shape_vals[5] = {4,6,8,12,20};
char *mouse_vals = "spm", *spin_vals = "+-r";
/* printf ("Handle Tcl data \n"); */
switch (xcd->format)
{
case 8: /* Character string from Tcl */
if (strcmp (xcd->char_val, "Quit!!"))
printf ("Mystery message from Tcl/chardata = %s \n",
xcd->char_val);
else
exit (101);
break;
case 32: /* Integer list from Tcl */
/* printf ("long ints = \n");
for (ix=0 ; ix<5; ix++)
printf (" %d ", xcd->int_val[ix]);
*/
ip2 = xcd -> int_val[1];
ip3 = xcd -> int_val[2];
/* By convention, we use the first integer as the opcode,
and subsequent ones as operands - but the meaning of the
integer list is set only by the sender and receiver
*/
switch (xcd -> int_val[0])
{
case 101: /* set mouse mode */
if (ip2 < 1 || ip2 > 3)
printf ("Bad 101 ip2 value = %d \n", ip2);
else
set_mouse_mode (mouse_vals[ip2-1]);
break;
case 102: /* set spin speed */
if (ip2 < 1 || ip2 > 3)
printf ("Bad 102 ip2 value = %d \n", ip2);
else
handle_spin_select (spin_vals[ip2-1]);
break;
case 103: /* adjust spaceball sensitivity */
if (ip2 == 15)
sb_rotate_factor *= ((ip3 == 1) ? 1.3 : 0.8);
else if (ip2 == 16)
sb_shift_factor *= ((ip3 == 1) ? 1.3 : 0.8);
else
printf ("Mystery 103 ip2 value = %d \n", ip2);
break;
case 104: /* select Platonic solid */
if (ip2 < 1 || ip2 > 5)
printf ("Bad 104 ip2 value = %d \n", ip2);
else
current_shape = shape_vals[ip2-1] + shrink_facet;
break;
case 105: /* set globe/shrink options */
if (ip2 == 1)
show_globe = ip3;
else if (ip2 == 2)
{
shrink_facet = (ip3) ? 100 : 0;
while (current_shape > 50) current_shape -= 100;
current_shape += shrink_facet;
}
else
printf ("Bad 105 ip2 value = %d \n", ip2);
break;
case 106: /* reset view */
printf ("Reset view \n");
cur_trans.lat =10;
cur_trans.longt = 0;
cur_trans.z_rot = 0;
cur_trans.x = 0;
cur_trans.y = 0;
cur_trans.z = 0;
delta_trans.lat = 0;
delta_trans.longt = 0;
delta_trans.z_rot = 0;
delta_trans.x = 0;
delta_trans.y = 0;
delta_trans.z = 0;
break;
case 111: /* test slider */
printf ("slider int = %d \n", ip2);
break;
default:
printf ("Mystery int from tcl = %d \n", xcd -> int_val[0]);
break;
} /* ENDWHILE: */
break;
default:
printf ("Oops, tcldata format = %d \n", xcd->format);
break;
}
glutPostRedisplay();
return;
}
/* =============================================================== */
#include "meta.h"
void handle_keyboard (unsigned char keyval, int xloc, int yloc)
{
char shape_codes[6] = "thodi", *shape_ptr;
if (shape_ptr = strchr(shape_codes, keyval))
{ glutPressTkButton (4 + (shape_ptr - shape_codes));
}
else
{
switch (keyval)
{
case 's':
glutPressTkButton ((mouse_mode == 's') ? PICK : SPIN);
break;
case '+':
case '-':
case 'r':
glutPressTkButton (SPIN);
handle_spin_select (keyval);
break;
case 'p': print_globe_spot (xloc,yloc); break;
/* Note that the globe-toggle button is the 9th in the
list sent by Tcl */
case 'g': glutPressTkButton (9); break;
/*
case 'S':
glutButton2Tk (10, 2, 110,20, 1);
printf ("affect slider \n");
break;
*/
case ' ': /* toggle effect of mouse */
glutPressTkButton ((mouse_mode == 'm') ? PICK : MOVE);
break;
default:
printf ("Mystery key = %c; x,y=%d,%d \n", keyval,xloc,yloc);
break;
}
}
return;
}