[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]

[http://gersoo.free.fr/wiki/w11832/tetra.gif]

 # 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''
----
[[
[Category Graphics] | 
[Category Mathematics]
]]