[Paul Obermeier] 2005/10/11 Another demo implemented with [tclogl]. I was asked, if it would be possible to use tclogl for molecule display. Here is a little application to test the possibilities of sphere rendering with tclogl. ---- [http://www.poSoft.de/images/spheres.png] ---- #!/bin/sh # The next line restarts using wish84 \ exec wish8.4 $0 ${1+"$@"} # TclOgl demo displaying spheres in various modes. # Author: Paul Obermeier # Date: 2005-10-11 package require tclogl package require Togl set no_mat { 0.0 0.0 0.0 1.0 } set mat_ambient { 0.7 0.7 0.7 1.0 } set mat_ambient_color { 0.8 0.8 0.2 1.0 } set mat_diffuse { 0.1 0.5 0.8 1.0 } set mat_specular { 1.0 1.0 1.0 1.0 } set no_shininess { 0.0 } set low_shininess { 5.0 } set high_shininess { 100.0 } set mat_emission {0.3 0.2 0.2 0.0} proc bgerror { msg } { tk_messageBox -icon error -type ok -message "bgerror: $msg" } proc RotX { w angle } { set ::xRotate [expr {$::xRotate + $angle}] $w postredisplay } proc RotY { w angle } { set ::yRotate [expr {$::yRotate + $angle}] $w postredisplay } proc RotZ { w angle } { set ::zRotate [expr {$::zRotate + $angle}] $w postredisplay } proc DrawSpheres {} { if { $::shadeModel == $::GL_SMOOTH } { glMaterialfv GL_FRONT GL_AMBIENT $::mat_ambient_color glMaterialfv GL_FRONT GL_DIFFUSE $::mat_diffuse glMaterialfv GL_FRONT GL_SPECULAR $::mat_specular glMaterialfv GL_FRONT GL_SHININESS $::high_shininess glMaterialfv GL_FRONT GL_EMISSION $::no_mat } set quadObj [gluNewQuadric] for { set x 0 } { $x < $::numSpheresPerDim } { incr x } { for { set y 0 } { $y < $::numSpheresPerDim } { incr y } { for { set z 0 } { $z < $::numSpheresPerDim } { incr z } { glPushMatrix glTranslatef $x $y [expr {-1.0 * $z}] if { $::lineMode } { gluQuadricDrawStyle $quadObj GLU_LINE } else { gluQuadricDrawStyle $quadObj GLU_FILL if { $::shadeModel == $::GL_SMOOTH } { gluQuadricNormals $quadObj GLU_SMOOTH } else { gluQuadricNormals $quadObj GLU_FLAT } } gluSphere $quadObj $::sphereSize $::numSlices $::numStacks glPopMatrix } } } gluDeleteQuadric $quadObj } proc ToggleDisplayList {} { if { $::useDisplayList } { if { ! [info exists ::sphereList] } { CreateDisplayList } } else { if { [info exists ::sphereList] } { glDeleteLists $::sphereList 1 unset ::sphereList } } } proc CreateDisplayList {} { if { $::useDisplayList } { if { [info exists ::sphereList] } { glDeleteLists $::sphereList 1 } set ::sphereList [glGenLists 1] glNewList $::sphereList GL_COMPILE DrawSpheres glEndList } } proc ShowAnimation { w } { if { $::animStarted == 0 } { return } set ::yRotate [expr {$::yRotate + 1}] set ::zRotate [expr {$::zRotate + 1}] $w postredisplay set ::animId [after idle ShowAnimation $w] } proc tclCreateFunc { w } { set ambient { 0.0 0.0 0.0 1.0 } set diffuse { 1.0 1.0 1.0 1.0 } set specular { 1.0 1.0 1.0 1.0 } set position { 0.0 3.0 2.0 0.0 } set lmodel_ambient { 0.4 0.4 0.4 1.0 } set local_view { 0.0 } glClearColor 0.0 0.1 0.1 0 glEnable GL_DEPTH_TEST glLightfv GL_LIGHT0 GL_AMBIENT $ambient glLightfv GL_LIGHT0 GL_DIFFUSE $diffuse glLightfv GL_LIGHT0 GL_POSITION $position glLightModelfv GL_LIGHT_MODEL_AMBIENT $lmodel_ambient glLightModelfv GL_LIGHT_MODEL_LOCAL_VIEWER $local_view glEnable GL_LIGHTING glEnable GL_LIGHT0 CreateDisplayList } proc tclDisplayFunc { w } { glShadeModel $::shadeModel glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] glPushMatrix glTranslatef $::xdist $::ydist [expr {-1.0 * $::zdist}] glRotatef $::xRotate 1.0 0.0 0.0 glRotatef $::yRotate 0.0 1.0 0.0 glRotatef $::zRotate 0.0 0.0 1.0 if { $::useDisplayList } { if { ! [info exists ::sphereList] } { CreateDisplayList } glCallList $::sphereList } else { DrawSpheres } glPopMatrix $w swapbuffers } proc tclReshapeFunc { toglwin w h } { glViewport 0 0 $w $h glMatrixMode GL_PROJECTION glLoadIdentity gluPerspective 60.0 [expr double($w)/double($h)] 1.0 2000.0 glMatrixMode GL_MODELVIEW glLoadIdentity gluLookAt 0.0 0.0 5.0 0.0 0.0 0.0 0.0 1.0 0.0 } proc UpdateNumSpheres { name1 name2 op } { set numSpheres [expr $::numSpheresPerDim*$::numSpheresPerDim*$::numSpheresPerDim] $::infoLabel configure -text "$numSpheres" } proc HandleRot {x y win} { global cx cy RotY $win [expr {180 * (double($x - $cx) / [winfo width $win])}] RotX $win [expr {180 * (double($y - $cy) / [winfo height $win])}] set cx $x set cy $y } proc HandleTrans {axis x y win} { global cx cy if { $axis != "Z" } { set ::xdist [expr {$::xdist + 0.1 * double($x - $cx)}] set ::ydist [expr {$::ydist - 0.1 * double($y - $cy)}] } else { set ::zdist [expr {$::zdist + 0.1 * (double($x - $cx))}] } set cx $x set cy $y $win postredisplay } set ::xdist 0 set ::ydist 0 set ::zdist 5 set ::xRotate 0.0 set ::yRotate 0.0 set ::zRotate 0.0 set ::shadeModel $::GL_SMOOTH set ::lineMode 0 set ::useDisplayList 0 set ::animStarted 0 wm title . "TclOgl spheres demo" set frTogl [frame .f1] set frSett [frame .f2] set frTfms [frame .f3] set frBttn [frame .f4] set frInfo [frame .f5] grid $frTogl -row 0 -column 0 -sticky news -columnspan 2 grid $frSett -row 1 -column 0 -sticky nws grid $frTfms -row 1 -column 1 -sticky nes grid $frBttn -row 2 -column 0 -sticky nws -columnspan 2 grid $frInfo -row 3 -column 0 -sticky news -columnspan 2 grid rowconfigure . 0 -weight 1 grid columnconfigure . 0 -weight 1 grid columnconfigure . 1 -weight 1 togl $frTogl.c -width 500 -height 500 \ -double true -depth true \ -displayproc tclDisplayFunc \ -reshapeproc tclReshapeFunc \ -createproc tclCreateFunc pack $frTogl.c -side top -expand 1 -fill both frame $frSett.fr1 label $frSett.fr1.l1 -text "Number of slices per sphere:" spinbox $frSett.fr1.s1 -from 4 -to 30 \ -textvariable ::numSlices -width 4 \ -command { CreateDisplayList ; $frTogl.c postredisplay } eval pack [winfo children $frSett.fr1] -side left -anchor w -expand 1 pack $frSett.fr1 -expand 1 -anchor w frame $frSett.fr2 label $frSett.fr2.l1 -text "Number of stacks per sphere:" spinbox $frSett.fr2.s1 -from 4 -to 30 \ -textvariable ::numStacks -width 4 \ -command { CreateDisplayList ; $frTogl.c postredisplay } eval pack [winfo children $frSett.fr2] -side left -anchor w -expand 1 pack $frSett.fr2 -expand 1 -anchor w frame $frSett.fr3 label $frSett.fr3.l1 -text "Number of spheres per side:" spinbox $frSett.fr3.s1 -from 1 -to 50 \ -textvariable ::numSpheresPerDim -width 4 \ -command { CreateDisplayList ; $frTogl.c postredisplay } eval pack [winfo children $frSett.fr3] -side left -anchor w -expand 1 pack $frSett.fr3 -expand 1 -anchor w frame $frSett.fr4 label $frSett.fr4.l2 -text "Total number of spheres:" label $frSett.fr4.info -text "-1" set ::infoLabel $frSett.fr4.info eval pack [winfo children $frSett.fr4] -side left -anchor w -expand 1 pack $frSett.fr4 -expand 1 -anchor w frame $frTfms.fr1 label $frTfms.fr1.lx -text "X translate:" scale $frTfms.fr1.sx -from -50 -to 50 -length 200 -resolution 0.5 \ -orient horiz -showvalue true \ -variable xdist \ -command { $frTogl.c postredisplay } eval pack [winfo children $frTfms.fr1] -side left -anchor nw -expand 1 pack $frTfms.fr1 -expand 1 -anchor w frame $frTfms.fr2 label $frTfms.fr2.ly -text "Y translate:" scale $frTfms.fr2.sy -from -50 -to 50 -length 200 -resolution 0.5 \ -orient horiz -showvalue true \ -variable ydist \ -command { $frTogl.c postredisplay } eval pack [winfo children $frTfms.fr2] -side left -anchor nw -expand 1 pack $frTfms.fr2 -expand 1 -anchor w frame $frTfms.fr3 label $frTfms.fr3.lz -text "Z translate:" scale $frTfms.fr3.sz -from -50 -to 50 -length 200 -resolution 0.5 \ -orient horiz -showvalue true \ -variable zdist \ -command { $frTogl.c postredisplay } eval pack [winfo children $frTfms.fr3] -side left -anchor nw -expand 1 pack $frTfms.fr3 -expand 1 -anchor w checkbutton $frBttn.b1 -text "Use display list" -indicatoron 1 \ -variable ::useDisplayList \ -command ToggleDisplayList checkbutton $frBttn.b2 -text "Use flat shading" -indicatoron 1 \ -variable ::shadeModel \ -offvalue $::GL_SMOOTH -onvalue $::GL_FLAT \ -command { $frTogl.c postredisplay } checkbutton $frBttn.b3 -text "Use line mode" -indicatoron 1 \ -variable ::lineMode \ -command { CreateDisplayList ; $frTogl.c postredisplay } checkbutton $frBttn.b4 -text "Animate" -indicatoron 0 \ -variable ::animStarted \ -command { ShowAnimation $frTogl.c } eval pack [winfo children $frBttn] -side left -expand 1 -fill x label $frInfo.l1 -text "TclOgl spheres demo: Copyright Paul Obermeier, 2005" \ -fg gray eval pack [winfo children $frInfo] -side left -expand 1 -fill x trace add variable ::numSpheresPerDim write UpdateNumSpheres set ::sphereSize 0.4 set ::numSlices 15 set ::numStacks 15 set ::numSpheresPerDim 5 bind $frTogl.c <1> {set cx %x; set cy %y} bind $frTogl.c <2> {set cx %x; set cy %y} bind $frTogl.c <3> {set cx %x; set cy %y} bind $frTogl.c {HandleRot %x %y %W} bind $frTogl.c {HandleTrans X %x %y %W} bind $frTogl.c {HandleTrans Z %x %y %W} bind all { exit }