[Paul Obermeier] 2005/07/27 The Sierpinski demo implemented with [tclogl]. TclOgl has been enhanced and renamed to [Tcl3D]. This is a slightly modified version of [Tetrahedron with 3dcanvas], but instead of using the [3dcanvas] package, it uses hardware accelerated OpenGL calls. See also [Optimized Tetrahedron with tclogl]. An updated version (including the optimizations mentioned above) is available as part of the [Tcl3D] demos at [http://www.tcl3d.org/cgi-bin/demolist.tcl?dir=LibrarySpecificDemos/tcl3dOgl]. ---- [http://www.poSoft.de/images/sierpinski3.png] [http://www.poSoft.de/images/sierpinski8.png] ---- #!/bin/sh # The next line restarts using wish84 \ exec wish8.4 $0 ${1+"$@"} # tetra-3dc.tcl # Author: Gerard Sookahet # Date: 2004-06-18 # Description: 3D Sierpinski Tetrahedron with 3dcanvas # Modified to use OpenGL (package tclogl) # Author: Paul Obermeier # Date: 2005-06-27 package require Tk package require tclogl package require Togl catch { console show } bind all { exit } proc About {} { set w .about catch {destroy $w} ; toplevel $w wm title $w "About this demo" message $w.msg -justify center -aspect 250 -relief sunken \ -text "tclogl demo: Sierpinski Tetrahedron\n\nGerard Sookahet, June 2004\n\nPaul Obermeier, June 2005" button $w.bquit -text OK -command {destroy .about} eval pack [winfo children $w] } 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 } # Animation loop proc Animate { w } { rotY $w 3 rotZ $w 3 after 32 Animate $w } proc Sierpinski { w level l } { global rdepth if {$level > $rdepth} then return set i 1 foreach {x y z} $l { set p($i) "$x $y $z" incr i } set p12 [MidPoint [concat $p(1) $p(2)]] set p13 [MidPoint [concat $p(1) $p(3)]] set p14 [MidPoint [concat $p(1) $p(4)]] set p23 [MidPoint [concat $p(2) $p(3)]] set p24 [MidPoint [concat $p(2) $p(4)]] set p34 [MidPoint [concat $p(3) $p(4)]] incr level if {$level == $rdepth} then { DrawTetra $w [concat $p(1) $p(2) $p(3) $p(4)] } Sierpinski $w $level [concat $p(1) $p12 $p13 $p14] Sierpinski $w $level [concat $p(2) $p12 $p23 $p24] Sierpinski $w $level [concat $p(3) $p13 $p23 $p34] Sierpinski $w $level [concat $p(4) $p14 $p24 $p34] } proc DrawTetra { w l } { #puts "DrawTetra $l" set i 1 foreach {x y z} $l { set p($i) [list $x $y $z] incr i } glBegin GL_TRIANGLES glColor3f 1 0 0 ; # RED glVertex3fv $p(1) glVertex3fv $p(2) glVertex3fv $p(3) glColor3f 1 1 0 ; # YELLOW glVertex3fv $p(2) glVertex3fv $p(3) glVertex3fv $p(4) glColor3f 0 0 1 ; # BLUE glVertex3fv $p(1) glVertex3fv $p(3) glVertex3fv $p(4) glColor3f 0 1 0 ; # GREEN glVertex3fv $p(1) glVertex3fv $p(2) glVertex3fv $p(4) glEnd incr ::numTrias 4 } # Return the middle coordinates of two 3d points proc MidPoint { l } { set X 0 set Y 0 set Z 0 foreach {x y z} $l { set X [expr {$X + $x}] set Y [expr {$Y + $y}] set Z [expr {$Z + $z}] } return [list [expr {$X/2}] [expr {$Y/2}] [expr {$Z/2}]] } proc Init { w } { set edge 340 set x1 [expr {sqrt(3)*$edge/3}] set x2 [expr {sqrt(3)*$edge/6}] set z3 [expr {sqrt(6)*$edge/3}] set y2 [expr {$edge/2}] # Vertices' coordinates of the regular tetrahedron set p1 "$x1 0 0" set p2 "-$x2 $y2 0" set p3 "-$x2 -$y2 0" set p4 "0 0 $z3" if { [info exists ::sierList] } { glDeleteLists $::sierList 1 } set ::sierList [glGenLists 1] glNewList $::sierList GL_COMPILE set ::numTrias 0 Sierpinski $w 0 [concat $p1 $p2 $p3 $p4] puts "Number of triangles: $::numTrias" glEndList } proc tclCreateFunc { w } { glClearColor 0 0 0 0 glEnable GL_DEPTH_TEST glShadeModel GL_FLAT Init $w } proc tclDisplayFunc { w } { glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT] glPushMatrix glTranslatef 0 0 [expr -1.0 * $::vdist] glRotatef $::xRotate 1.0 0.0 0.0 glRotatef $::yRotate 0.0 1.0 0.0 glRotatef $::zRotate 0.0 0.0 1.0 glCallList $::sierList 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 } set vdist 400 set rdepth 1 set xRotate 0.0 set yRotate 0.0 set zRotate 0.0 wm title . "Sierpinski Tetrahedron" togl .c -width 500 -height 500 \ -double true -depth true \ -displayproc tclDisplayFunc \ -reshapeproc tclReshapeFunc \ -createproc tclCreateFunc pack .c -side top set f1 [frame .f1] label $f1.l1 -text "Recursive depth " spinbox $f1.sdepth -from 1 -to 10 -textvariable rdepth -width 4 label $f1.l2 -text " View distance " scale $f1.vd -from 0 -to 1000 -length 200 -orient horiz -showvalue true \ -variable vdist -command {.c postredisplay} eval pack [winfo children $f1] -side left pack $f1 set f2 [frame .f2] button $f2.brun -text "Run" -width 10 -fg white -bg blue -command {Init .c} button $f2.bromega -text "Z rotate" -width 10 -command {rotZ .c 8} button $f2.brphi -text "Y rotate" -width 10 -command {rotY .c 8} button $f2.brtheta -text "X rotate" -width 10 -command {rotX .c 8} button $f2.banim -text Animate -width 10 -command {Animate .c} button $f2.babout -text A -width 1 -bg grey -command {About} button $f2.bquit -text Quit -width 10 -bg grey -command exit eval pack [winfo children $f2] -side left pack $f2 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 } bind .c <1> {set cx %x; set cy %y} bind .c {handleRot %x %y %W} ---- This is wrong: scale $f1.vd -from 0 -to 1000 -length 200 -orient horiz -showvalue true -variable vdist -command {.c postredisplay} "scale" passed in parameter to ".c postredisplay " and it doesn't like that. Also, tclReshapeFunc callback passed in only one value. So it has to be =====c proc tclReshapeFunc { toglwin { w -1 } { h -1 } } { set w [$toglwin width] set h [$toglwin height] ===== <> Category Graphics|Category 3D Graphics|Category Tcl3D