Version 14 of Tetrahedron with 3dcanvas

GS - This little demo uses the 3dcanvas widget to draw a Sierpinski tetrahedon. We start with a tetrahedron which is replaced by 4 tetrahedra with half the previous edge length at the four corners. Then we repeat the process for the remaining tetrahedra.

  The 3dcanvas shared library is available for:

  - Linux [http://gersoo.free.fr/inform/tcl/3dcanvas/dddcanvas10.so]

  - Windows [http://gersoo.free.fr/inform/tcl/3dcanvas/dddcanvas10.dll] (compiled by [EB])

 # tetra-3dc.tcl 
 # Author: Gerard Sookahet
 # Date: 2004-06-18
 # Description: 3D Sierpinski Tetrahedron with 3dcanvas

 package require Tk
 load ./dddcanvas10[info sharedlibextension]

 bind all <Escape> { 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 "3dcanvas demo: Sierpinski Tetrahedron\n\nGerard Sookahet\n\nJune 2004"
  button $w.bquit -text OK -command {destroy .about}
  eval pack [winfo children $w]
 }

 # Animation loop
 proc Animate {} {
     global G
  .c phirot $G 3
  .c thetarot $G 3
  after 32 Animate
 }

 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 } {
     global G
  set i 1
  foreach {x y z} $l {
         set p($i) "$x $y $z"
         incr i
  }
  $w addgroup $G items [eval $w create polygon [join [concat $p(1) $p(2) $p(3)] " "] -fill red]
  $w addgroup $G items [eval $w create polygon [join [concat $p(2) $p(3) $p(4)] " "] -fill yellow]
  $w addgroup $G items [eval $w create polygon [join [concat $p(1) $p(3) $p(4)] " "] -fill blue]
  $w addgroup $G items [eval $w create polygon [join [concat $p(1) $p(2) $p(4)] " "] -fill green]

 }

 # 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 } {
     global G
  $w delete all
  set G [.c create group]

  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"

  Sierpinski $w 0 [concat $p1 $p2 $p3 $p4]
 }

 proc Main {} {
     global somega sphi stheta
     global vdist 
     global rdepth 

   set vdist 2400
   set rdepth 4

   wm title . "Sierpinski Tetrahedron"
   3dcanvas .c -bg black -width 500 -height 500
   pack .c -side top

   set f1 [frame .f1]
   label $f1.l1 -text "Recursive depth "
   spinbox $f1.sdepth -from 1 -to 7 -textvariable rdepth -width 4
   label $f1.l2 -text "   View distance "
   scale $f1.vd -from 4600 -to 1000 -length 210 -orient horiz -showvalue true \
                -variable vdist -command {.c configure -viewdistance}
   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 "Omega rotate" -width 10 -command {.c omegarot $G 8}
   button $f2.brphi -text "Phi rotate" -width 10 -command {.c phirot $G 8}
   button $f2.brtheta -text "Theta rotate" -width 10 -command {.c thetarot $G 8}
   button $f2.banim -text Animate -width 10 -command {Animate}
   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 
 }

 Main

MDD: I get the following error on Win2k: "couldn't load library "./dddcanvas10.dll": this library or a dependent library could not be found in library path" I'm running TclKit 8.4.2, and the dddcanvas10.dll file is in the launch directory. I even tried explicitly loading the dll from the console, but got the same error.

To ask a possibly stupid question: did you have the DLL in the same directory as Wish (c:/tcl/bin if you use the default installation dir)? Otherwise, you'd need to change the path

MDD: Yup. I'm using Tclkit, and routinely load dlls in that manner, such as the Img or SQLite dlls, without any problems. Does the dll have any dependencies that might conflict with invocation via tclkit.exe?

Yes, the dll is not stub-enabled, so require tcl84.dll and tk84.dll MDD: That would explain it. ;-)

LES: works for me on Windows 98. But I couldn't see and use the control buttons until I replaced set vdist 2400 with set vdist 2000 on line 104. My screen res is 800x600.

FW: Add this at the end to allow for click-and-drag rotation:

 proc handleRot {x y win} { global cx cy G
   $win phirot $G [expr {180 * (double($x - $cx) / [winfo width $win])}]
   $win thetarot $G [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 <B1-Motion> {handleRot %x %y %W}

[ Category Graphics | Category 3D Graphics | Category Mathematics ]